我想将网络文件夹中的文件移动到另一个网络文件夹，但似乎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
答案 0 :(得分：0)
在你的第一个例子中，你的对象被称为“fso”，然后当你尝试使用你所使用的移动和名为“fsoexist”的对象时，你是否实例化了fsoexist，或者这行应该说
fso.MoveFile File, Moveto & "\" & filenamehere
答案 1 :(得分：0)
您可以尝试在没有FileSystemObject的情况下执行此操作。
FileCopy <sourcefile>, <destinationfile>
Kill <sourcefile>
答案 2 :(得分：0)
最后找到一个解决方案我不太确定为什么但是使用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 / Dec模块
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功能？”我不知道！我只想拥有自己的TimeMachine。只是为自己感到困惑。