移动文件在网络文件夹到另一个网络文件夹在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>