Question

MS Access vba to match filename with folder name

By AlOffTech ·
I would need help with an MS Access vba function that would loop through a folder populated with Excel files then copy these files to a matching destination folder name (extension .xlsx removed). Any unmatched files would be copied to a new folder (in the source folder) with the name of the file (less extension) then killed in the source folder. The 1st loop works OK but then the 2nd loop is wrong. Here is the vba:

Public Function CopyFilesToMatchFolders()

On Error GoTo Exit_Copy

Dim sourcefiles As String
Dim Sourcefileslen
Dim SubFolder
Dim destination As String
Dim source As String

Dim FileSystem As Object

Set FileSystem = CreateObject("Scripting.FileSystemObject")

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Select a folder that contains files to copy."

If .Show = -1 Then source = .SelectedItems(1)
If Len(source) = 0 Then Exit Function
.AllowMultiSelect = True

.Title = "Select a folder location to copy the files."

If .Show = -1 Then destination = .SelectedItems(1)

If Len(destination) = 0 Then Exit Function

End With

sourcefiles = Dir$(source & "\*.*")

Do While Len( sourcefiles) > 0

For Each SubFolder In FileSystem.GetFolder(destination).subfolders

Sourcefileslen = Left(sourcefiles, 7)
SubFolderlen = Right(SubFolder, 7)

If Sourcefileslen = SubFolderlen Then

FileCopy (source & "\" & sourcefiles), (SubFolder.Path & "\" & sourcefiles)

Else
MkDir (source & "\" & Sourcefileslen)
FileCopy (source & "\" & sourcefiles), (source & "\" & Sourcefileslen & "\" & sourcefiles)
Kill (source & "\" & sourcefiles)

End If

Next

sourcefiles = Dir$

Loop

MsgBox "The selected files have been copied to the matching selected subfolders!", vbInformation

Exit_Copy:

Exit Function

Err_Copy:
CopyFilesToFolders = True
MsgBox Error$
Resume Exit_Copy

End Function
0 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Answers

Share your knowledge
Back to Software Forum
0 total posts (Page 1 of 1)  

Related Discussions

Related Forums