Copying pdf files from a folder to another

[LonghronJ]

Hi,

I'm having a hard time looping through all files in a folder. I get invalid procedure message when it reaches the line "strCurrentFileName = Dir". If I comment that out, it gets stuck on the first file. FileExists() is a function that checks if a file already exists in a given folder.

   
            If Len(Dir(strCurrentPdfFolder)) <> 0 Then
                    Set fso = CreateObject("scripting.filesystemobject")
                    strCurrentFileName = Dir(strCurrentPdfFolder & "*.pdf")
                    Do While Len(strCurrentFileName) > 0
                    
                        If Right(strCurrentFileName, 3) = "pdf" Then


                            strCurrentFolderAndFile = strCurrentPdfFolder & strCurrentFileName
                            strFutureFolderAndFile = strFuturePdfFolder & strCurrentFileName
                            
                            If FileExists(strFutureFolderAndFile) = False Then 
                                Call fso.CopyFile(strCurrentFolderAndFile, strFutureFolderAndFile, 0)
                            End If
                            
                            strCurrentFileName = Dir
                           
                        End If
                    Loop

[moke123]

You dont need to use Dir(), this can all be done with FSO.

    Dim fso As New FileSystemObject
    Dim fil As File
    Dim fol As Folder
    
    Set fol = fso.GetFolder(FolPath)


    For Each fil In fol.Files


        If fso.GetExtensionName(fil.Path) = "Pdf" Then


            Debug.Print fil.Name, fil.Path


        End If


    Next

You can test if the destination folder contains the pdf with fso.FileExists(fil.path)

You can move or copy the file with fso also.

Google:
fso.CopyFile
fso.MoveFile

[ranman256]

usage: CopyPdfFilesInSrcDir2TargDir [source Folder], [Target Folder]

Public Sub CopyPdfFilesInSrcDir2TargDir(ByVal pvDir, ByVal pvTargDir)
Dim fso, oFolder, oFile, vFile
Dim sTxt As String, sFile As String
Dim acc As Access.Application
Dim control As Office.CommandBarControl
Dim bRun As Boolean
Dim i As Integer
On Error GoTo errGetFiles
  'fix targ dir name
If Right(pvTargDir, 1) <> "\" Then pvTargDir = pvTargDir & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(pvDir)
Set acc = New Access.Application
For Each oFile In oFolder.Files
     If InStr(oFile.Name, ".pdf") > 0 Then 'only pdf files
         vTargFile = pvTargDir & oFile.Name
         Copy1File oFile, vTargFile
    End If
Next
Endit:
Set oFile = Nothing
Set oFolder = Nothing
Set fso = Nothing
Set acc = Nothing
Set control = Nothing
MsgBox "Done"
Exit Sub
errGetFiles:
  MsgBox Err.Description, , Err
  Resume Endit
End Sub

Public Function Copy1File(ByVal pvSrc, ByVal pvTarg) As Boolean
Dim fso
On Error GoTo errMake
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile pvSrc, pvTarg
Copy1File = True
Set fso = Nothing
Exit Function
errMake:
'MsgBox Err.Description & vbCrLf & pvSrc, , "Copy1File(): " & Err
debug.print "err: " & pvSrc
Set fso = Nothing
End Function

[Gicu]

Your original code slightly modified to account to what I think were missing "" in the paths:

If Len(Dir(strCurrentPdfFolder)) <> 0 Then
   Set fso = CreateObject("scripting.filesystemobject")
   strCurrentFileName = Dir(strCurrentPdfFolder & "\" & "*.pdf")
   'Do While Len(strCurrentFileName) > 0
        Do While strCurrentFileName<> ""
           'If Right(strCurrentFileName, 3) = "pdf" Then 'you don't need this as you already filter on PDFs
            strCurrentFolderAndFile = strCurrentPdfFolder & "\" & strCurrentFileName
            strFutureFolderAndFile = strFuturePdfFolder & "\" & strCurrentFileName                            
                If FileExists(strFutureFolderAndFile) = False Then 
                    Call fso.CopyFile(strCurrentFolderAndFile, strFutureFolderAndFile, 0)
                End If                            
            strCurrentFileName = Dir                           
           'End If
        Loop
End If

Cheers,

[LonghronJ]

Thanks, Moke. From the initial test, it seems to work. I will continue to test.

You dont need to use Dir(), this can all be done with FSO.

    Dim fso As New FileSystemObject
    Dim fil As File
    Dim fol As Folder
    
    Set fol = fso.GetFolder(FolPath)


    For Each fil In fol.Files


        If fso.GetExtensionName(fil.Path) = "Pdf" Then


            Debug.Print fil.Name, fil.Path


        End If


    Next

You can test if the destination folder contains the pdf with fso.FileExists(fil.path)

You can move or copy the file with fso also.

Google:
fso.CopyFile
fso.MoveFile

[moke123]

This is closer to what your looking for than my previous post

    Dim fso As New FileSystemObject
    Dim fil As File
    Dim fol As Folder


    Set fol = fso.GetFolder(strFolderPath)


    For Each fil In fol.Files


        If fso.GetExtensionName(fil.Path) = "Pdf" Then   'test for pdf file


            If Not fso.FileExists(fso.BuildPath(gDestination, fil.Name)) Then     'test that file is not already in destination folder


                fso.CopyFile fil.Path, fso.BuildPath(gDestination, fil.Name), False


            End If


        End If


    Next


    'ListFiles gDestination, Me.lstDestination  'list the files in destination folder


    Set fso = Nothing

Here's a demo