Question

I want to move my files in a network folder to another network folder but seems like vb6 Scripting.FileSystemObject cannot do anything about this..

    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

Some how this does not work.. It gives the path not found error. I triple checked the path and permissions they are all working fine. Its the Scripting.FileSystemObject that fails at the network folders so i need a way trough this to carry my files in a network folder to another one. How can i achive this?

Given extended info about my code down here..

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

Found a solution at last I’m not really sure why but using FileListBox solves this problem.
I guess the files i’m trying to move needs to be cached first it should be caused by the disk.

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

I really dont know why this happens but for those who may have the same problem with these kinda disks FileListBox solves it.

Edit: for those who would like to use my modules..

1- ProgressInc/Dec Module

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- My own Log Module

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

You may ask “why there is a TimeMachine function here?” I dont know! i just wanted to have my own TimeMachine. Just puzzling with my self.