Наконец-то нашел решение. Я не совсем уверен, почему, но использование 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. Просто озадачиваю себя.