移動文件在網絡文件夾到另一個網絡文件夾在VB6

Question

我想移動網絡文件夾到另一個網絡文件夾我的文件，但似乎像VB6 Scripting.FileSystemObject的不能做的事..

Set fso = CreateObject("Scripting.FileSystemObject") 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    '''''''''''''''''''''''''''''''' DEFINITION FOR PATH '''''''''''''''''''''''''''''''' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     Set Directory = fso.GetFolder(fromparentfolder & fromfolder)     '' 
     Set Moveto = fso.GetFolder(toparentfolder & tofolder)       '' 
     Set Files = Directory.Files             '' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    DoEvents 
    'foreach file in directory 
    For Each File In Files 

     filenamehere = fso.GetFileName(File) 
     fso.MoveFile File, Moveto & "\" & filenamehere 

    Next 

一些如何這不起作用..它給出了路徑找不到錯誤。我三重檢查了路徑和權限，他們都工作正常。它的Scripting.FileSystemObject在網絡文件夾失敗，所以我需要一種方式槽這將我的文件在一個網絡文件夾到另一個。我怎樣才能做到這一點？

鑑於對我的代碼擴展的信息在這裏下來..

Private Sub netcarryon_Click() 

    'Disable button to block double clicking for the dummies.. 
    netcarryon.Enabled = False 

    FromNetTxt.Enabled = False 
    ToNetTxt.Enabled = False 

    NetworkDeleteFolder.Enabled = False 

    ToNetTxt.Text = Trim(ToNetTxt.Text) 'Result \\192.168.1.65\OldPics 
    FromNetTxt.Text = Trim(FromNetTxt.Text) 'Result \\192.168.1.65\Pics 

    If Right(FromNetTxt.Text, 2) <> "\\" Then 

     fromparentfolder = FromNetTxt.Text 

     'Keep going till u find parent folder 
     Do 
      fromparentfolder = Mid(fromparentfolder, 1, Len(fromparentfolder) - 1) 
     Loop Until Right(fromparentfolder, 1) = "\" 'When u reach SLASH "\" stop. 

     'There is the name of your folder. 
     fromfolder = Right(FromNetTxt.Text, Len(FromNetTxt.Text) - Len(fromparentfolder)) 

    Else 

     'You should give me a valid network path to process. 
     MsgBox "Please enter a valid network path..", vbInformation, "Not a valid path!" 

     'Enable the button that is disabled cause of dummies.. 
     netcarryon.Enabled = True 

     FromNetTxt.Enabled = True 
     ToNetTxt.Enabled = True 

     NetworkDeleteFolder.Enabled = True 

     Exit Sub 

    End If 

    If Right(ToNetTxt.Text, 2) <> "\\" Then 

     toparentfolder = ToNetTxt.Text 

     'Again keep going until you find the parent folder 
     Do 
      toparentfolder = Mid(toparentfolder, 1, Len(toparentfolder) - 1) 
     Loop Until Right(toparentfolder, 1) = "\" 'Stop at SLASH "\". 

     'There is ur target folder 
     tofolder = Right(ToNetTxt.Text, Len(ToNetTxt.Text) - Len(toparentfolder)) 

    Else 

     'Oh! Not a valid target network path ha? How dare you... 
     MsgBox "Please enter a valid network path..", vbInformation, "Not a valid network path!" 

     'Again release dummy protection. 
     netcarryon.Enabled = True 

     FromNetTxt.Enabled = True 
     ToNetTxt.Enabled = True 

     NetworkDeleteFolder.Enabled = True 

     Exit Sub 

    End If 

    'You sure you wanna choose these network paths? 
    If MsgBox("Are you sure you want to carry files in this folder : (" & FromNetTxt.Text & ")to this folder : (" & ToNetTxt.Text & ")?", vbYesNo, "Are you sure?") = vbNo Then 

     'Release dummy protection again and again. Now please chose it wisely, would ya! 
     netcarryon.Enabled = True 

     FromNetTxt.Enabled = True 
     ToNetTxt.Enabled = True 

     NetworkDeleteFolder.Enabled = True 

     Exit Sub 

    End If 

    'Add the folder script 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    '''''''''''''''''''''''''''''''' DEFINITION FOR PATH '''''''''''''''''''''''''''''''' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     Set Directory = fso.GetFolder(fromparentfolder & fromfolder)     '' 
     Set Moveto = fso.GetFolder(toparentfolder & tofolder)       '' 
     Set Files = Directory.Files             '' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

    DoEvents 
    'foreach file in directory 
    For Each File In Files 

     filenamehere = fso.GetFileName(File) 
     fso.MoveFile File, Moveto & "\" & filenamehere 

    Next 

    'At the end if everthing went fine and delete folder checked! 
    If DeleteFolder = 1 Then 

     'Delete folder 
     fso.DeleteFolder FromNetTxt.Text, True 

    End If 

    'You know what this is.. 
    netcarryon.Enabled = True 

    FromNetTxt.Enabled = True 
    ToNetTxt.Enabled = True 

    NetworkDeleteFolder.Enabled = True 

    MsgBox "Program finished successfully.", vbOKOnly, "Finished!" 

End Sub 

Answer 1

終於找到解決方案我不太確定爲什麼，但使用FileListBox解決了這個問題。 我想我試圖移動的文件需要首先緩存它應該是由磁盤引起的。

Private Sub Timer1_Timer() 
    Dim fso As Scripting.FileSystemObject 
    Set fso = New Scripting.FileSystemObject 

    'Path of the list box 
    FromPath = "\\192.168.1.65\OldPics\" 
    ToPath = "\\192.168.1.50\AllPics\" 
    FileListBox1.Path = FromPath 

    If Connection = False Or Finished = False Then 

     DoEvents 
     For i = 0 To FileListBox1.ListCount - 1 
      OurFile = "\" & FileListBox1.List(i) 
      'For each file in it 
      If fso.CopyFile(FromPath & OurFile, ToPath & OurFile, True) = True Then 
       Log "(" & OurFile & ") file has been copied from (" & FromPath & ") to (" & ToPath & "). Success!", False, True, True 
      Else 
       ''''''''''''''''''''''''''''''' Log Module '''''''''''''''''''''''''''''''' 
       ''Usage: LogString, LogDate, LogTime, DateTimeBeforeLog, DateTimeAfterLog'' 
       ''Log  "Hello" , False , True ,  True  ,  False  '' 
       ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
       Log "(" & OurFile & ") file could not be copied from (" & FromPath & ") to (" & ToPath & "). Faliure!", False, True, True 
      End If 
     Next 

    Else 

     End 

    End If 

    '''''''''''''''''''''''''' ProgressInc/Dec Module ''''''''''''''''''''''''' 
    ''  Usage: ProgressBar, MaxValue, MinValue, Increment, Continues  '' 
    ''  Usage: ProgressBar, MaxValue, MinValue, Decrement, Continues  '' 
    ''  Default Max = 100 , Min = 1, Inc = 1, False      '' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    ProgressInc ProgressBar1, 100, 1, 1, True 
    ProgressDec ProgressBar2, 100, 1, 1, True ' 
    Time = Time + 30 'Do these events every 30 sec 

End Sub 

我真的不知道爲什麼會這樣，但對於那些誰可能與這些還挺盤FileListBox中解決它有同樣的問題。

編輯：對於那些想用我的模塊誰..

1 ProgressInc /減速模塊

Public Sub ProgressDec(ProgressBarName As ProgressBar, Optional Max As Long, Optional Min As Long, Optional Dec As Long, Optional Continues As Boolean = False) 
    Dim Recent As Long 

    On Error GoTo ProgressErr 

    ProgressBarName.ShowWhatsThis 

    DoEvents 
    'Maximum ProgressBar Value 
    If Max <> 0 Then 
     ProgressBarName.Max = Max 'If set use it 
    Else 
     Max = 100 'If max value is not set then make it 100 
     ProgressBarName.Max = Max 
    End If 

    DoEvents 
    'Minimum ProgressBar Value 
    If Min <> 0 Then 
     ProgressBarName.Min = Min 'If set use it 
    Else 
     Min = 1 'If minimum value is not set then make it 1 
     ProgressBarName.Min = Min 
    End If 

    If Dec <> 0 Then Dec = Dec Else Dec = 1 

    'When the ProgressBar value is at Minimum 
    'Return to the Maximum value 
    If Continues = True And ProgressBarName.Value = Min Then 
     ProgressBarName.Value = Max 
    End If 

    'Checkout Recent progress (pre calculate bar value) 
    Recent = ProgressBarName.Value - Dec 

    DoEvents 
    If Recent <= Min Then 
     'Recent value is lower than or equals to Min value 
     'to avoid errors caused by this issue value should equal to Min 
     ProgressBarName.Value = Min 
    ElseIf Recent > Min Then 
     'Recent(pre calculated bar value) is higher than Min 
     'So nothing wrong here, proceed.. 
     ProgressBarName.Value = ProgressBarName.Value - Dec 
    End If 

    Exit Sub 

ProgressErr: 

    'ProgressBar is null then create an error report. 
    MsgBox "With " & Err.Number & " number : '" & Err.Description & "' error occured. " 
    'MsgBox "ProgressBar is not defined or Cant found the ProgressBar.. Please check the name of ProgressBar and re identify it.", vbCritical, "Unidentified ProgressBar!" 

End Sub 

Public Sub ProgressInc(ProgressBarName As ProgressBar, Optional Max As Long, Optional Min As Long, Optional Inc As Long, Optional Continues As Boolean = False) 
    Dim Recent As Long 

    On Error GoTo ProgressErr 

    ProgressBarName.ShowWhatsThis 

    DoEvents 
    'Maximum ProgressBar Value 
    If Max <> 0 Then 
     ProgressBarName.Max = Max 'If set use it 
    Else 
     Max = 100 'If max value is not set then make it 100 
     ProgressBarName.Max = Max 
    End If 

    DoEvents 
    'Minimum ProgressBar Value 
    If Min <> 0 Then 
     ProgressBarName.Min = Min 'If set use it 
    Else 
     Min = 1 'If min value is not set then make it 1 
     ProgressBarName.Min = Min 
    End If 

    If Inc <> 0 Then Inc = Inc Else Inc = 1 

    'When the ProgressBar value is at Maximum 
    'Return to the Minimum value 
    If Continues = True And ProgressBarName.Value = Max Then 
     ProgressBarName.Value = Min 
    End If 

    'Checkout Recent progress (pre calculate bar value) 
    Recent = ProgressBarName.Value + Inc 

    DoEvents 
    If Recent >= Max Then 
     'Recent value is higher than or equals to Max value 
     'to avoid errors caused by this issue Value should equal to Max 
     ProgressBarName.Value = Max 
    ElseIf Recent < Max Then 
     'Recent(pre calculated bar value) is lower than Max 
     'So nothing wrong here, proceed.. 
     ProgressBarName.Value = ProgressBarName.Value + Inc 
    End If 

    Exit Sub 

ProgressErr: 

    'ProgressBar error report. 
    MsgBox "With " & Err.Number & " number : '" & Err.Description & "' error occured. " 
    'MsgBox "ProgressBar is not defined or Cant found the ProgressBar.. Please check the name of ProgressBar and re identify it.", vbCritical, "Unidentified ProgressBar!" 

End Sub 

2 - 我自己的日誌模塊

Dim fso As Scripting.FileSystemObject 
Dim logfile As Integer 
Dim tarih As String 

Function CheckPath(ByVal Path As String) As String 

    If Right(Trim(Path), 1) = "\" Then 
     CheckPath = Mid(Trim(Path), 1, Len(Trim(Path)) - 1) 
    Else 
     CheckPath = Trim(Path) 
    End If 

End Function 

Function Log(LogString As String, Optional LogDate As Boolean, Optional LogTime As Boolean, Optional BeforeLogText As Boolean = False, Optional AfterLogText As Boolean = False) As Boolean 
    Dim WillBePrinted As String 

    On Err GoTo LogErr 

    If BeforeLogText = True Then 

     'Date Time Before Log 
     WillBePrinted = "(" & Now & ") " & LogString 

    ElseIf AfterLogText = True Then 
     'Date Time After Log 
     WillBePrinted = LogString & " (" & Now & ")" 
    Else 
     'No DateTime Included 
     WillBePrinted = LogString 
    End If 

    Print #logfile, WillBePrinted 

    Log = True 

LogErr: 

    Log = False 

End Function 

Function CreateLog(Optional Name As String, Optional Path As String, Optional DateTimeBeforeName As Boolean = False) As Boolean 
    Dim fso As New Scripting.FileSystemObject 
    Set fso = New Scripting.FileSystemObject 
    logfile = FreeFile 

    DoEvents 
    'Name of Log File 
    If Trim(Name) <> "" Then 
     Name = Trim(Name) 
    Else 
     Name = Trim(App.EXEName) 
    End If 

    DoEvents 
    'Path to Log File 
    If Trim(Path) <> "" Then 
     Path = CheckPath(Path) 
    Else 
     Path = CheckPath(App.Path) 
    End If 

    'If the path does not exists create it! 
    If fso.FolderExists(Path) = False Then 
     fso.CreateFolder Path 
    End If 

    'DateTimeBeforeName 
    If DateTimeBeforeName = True Then 

     DoEvents 
     FullPath = Path & "\" & TimeMachine & " - " & Name & ".txt" 
     'if already exists (Highly unlikely while date time is involved) 
     If (fso.FileExists(FullPath) = True) Then 
      fso.DeleteFile FullPath, True 
      Open Path & "\" & TimeMachine & " - " & Name & ".txt" For Output As #logfile 
     Else 
      Open Path & "\" & TimeMachine & " - " & Name & ".txt" For Output As #logfile 
     End If 

    ElseIf DateTimeBeforeName = False Then 

     DoEvents 
     FullPath = Path & "\" & Name & ".txt" 
     'if already exists (Highly posible while date time is not involved) 
     If (fso.FileExists(FullPath) = True) Then 
      fso.DeleteFile FullPath, True 
      Open Path & "\" & Name & ".txt" For Output As #logfile 
     Else 
      Open Path & "\" & Name & ".txt" For Output As #logfile 
     End If 

    End If 

    DoEvents 
    'Now if everything was successfull 
    If (fso.FileExists(FullPath) = True) Then 
     CreateLog = True 
    Else 
     CreateLog = False 
    End If 

End Function 

Function TimeMachine(Optional OnlyDate As Boolean = False) As String 
    Dim MyDate, MyTime As String 

    'Get local date 
    For Each Part In Split(Date, ".") 
     'Some times 01.01.2012 is shown as 1.1.2012 
     'to fix this do a zero check.. 
     If Len(Part) < 3 And Len(Part) > 0 Then Part = Right("00" & Part, 2) Else Part = Part 
     MyDate = MyDate & "." & Part 
    Next 

    'Get local time 
    For Each Part In Split(Time, ":") 
     'Some times 01.01.2012 is shown as 1.1.2012 
     'to fix this do a zero check.. 
     If Len(Part) < 3 And Len(Part) > 0 Then 
      MyTime = MyTime & "." & Right("00" & Part, 2) 
     End If 
    Next 

    'Clean "." at start 
    MyDate = Mid(MyDate, 2, Len(MyDate)) 
    MyTime = Mid(MyTime, 2, Len(MyTime)) 

    'Publish 
    If OnlyDate = True Then 
     TimeMachine = "Date " & MyDate 
    Else 
     TimeMachine = "Date " & MyDate & " Time " & MyTime 
    End If 

End Function 

你可能會問「爲什麼有TimeMachine func在這裏？「我不知道！我只想擁有自己的TimeMachine。只是困惑着我的自我。

Answer 2

在你的第一個例子，你的對象稱爲「FSO」，那麼當您嘗試所謂的「fsoexist」您使用的移動和對象，你實例化fso存在或應該這樣說

fso.MoveFile File, Moveto & "\" & filenamehere 

Answer 3

您可以嘗試在沒有FileSystemObject的情況下執行此操作。

FileCopy <sourcefile>, <destinationfile> 
Kill <sourcefile>