Reputation: 13
I want to move files to created folders. I got a mismatch error every time.
The aim is to create a folder named after the file prefix if it doesn't exist and copy the file to that folder.
I get
mismatch error
Sub loopf()
Dim AcceptedPrefixes As Object
Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
Dim PrefixRange As Range
Set PrefixRange = ThisWorkbook.Sheets(1).Range("B2:B368")
Dim Cell As Range
For Each Cell In PrefixRange.Cells
If Cell <> "" And Not AcceptedPrefixes.exists(Cell.Value) Then
AcceptedPrefixes.Add CStr(Cell.Value), 0
End If
Next
Dim Directory As String
Directory = "C:\TEST\"
Dim fsoFSO
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
Dim filen As Variant
filen = Dir(Directory)
While filen <> ""
Dim FilePrefix As String
FilePrefix = "" & (Split(filen, "_")(0)) & ""
If Not AcceptedPrefixes.exists(FilePrefix) Then
Kill Directory & filen
Else
If fsoFSO.FolderExists("C:\TEST\" & FilePrefix) Then
'DO NOTHING
Else: fsoFSO.CreateFolder ("C:\TEST\" & FilePrefix) 'ELSE CREATE A FOLDER
' HERE i WANT TO MOVE THE FILES TO TRHE CREATED FOLDER OR EXISTING FOLDER
fso.MoveFile "C:\TEST\ & Filen", "C:\TEST\ & FilePrefix&" \ ""
End If
End If
filen = Dir
Wend
End Sub
Upvotes: 0
Views: 266
Reputation: 9179
fsoFSO
is not fso
.
fsoFSO.CreateFolder ...
fso.MoveFile ...
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub loopf()
Dim AcceptedPrefixes As Object
Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
Dim PrefixRange As Range
Set PrefixRange = ThisWorkbook.Sheets(1).Range("B2:B368")
Dim Cell As Range
For Each Cell In PrefixRange.Cells
If Cell <> "" And Not AcceptedPrefixes.Exists(Cell.Value) Then
AcceptedPrefixes.Add CStr(Cell.Value), 0
End If
Next
Dim Directory As String
Directory = "C:\TEST\"
Debug.Print "Directory: " & Directory
Dim fsoFSO
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
Dim filen As Variant
filen = Dir(Directory)
Dim sourceFile As String
Dim destinationFolder As String
Dim destinationFile As String
While filen <> ""
Debug.Print
Debug.Print "filen.....: " & filen
Dim FilePrefix As String
FilePrefix = "" & (Split(filen, "_")(0)) & ""
Debug.Print "FilePrefix: " & FilePrefix
sourceFile = Directory & filen
Debug.Print " sourceFile........: " & sourceFile
If Not AcceptedPrefixes.Exists(FilePrefix) Then
'Kill sourceFile
Debug.Print " Kill " & sourceFile
Else
destinationFolder = Directory & FilePrefix
Debug.Print " destinationFolder.: " & destinationFolder
If fsoFSO.FolderExists(destinationFolder) Then
Debug.Print " Folder exists....: " & destinationFolder
Else
fsoFSO.createFolder (destinationFolder)
Debug.Print " Folder **created**: " & destinationFolder
End If
' Move files to created or existing folder
destinationFile = destinationFolder & "\" & filen
Debug.Print " destinationFile..: " & destinationFile
fsoFSO.MoveFile sourceFile, destinationFile
Debug.Print " file moved to: " & destinationFolder
End If
filen = Dir
Wend
Debug.Print
Debug.Print "** Done ** "
End Sub
Upvotes: 0
Reputation: 13
Ok. I did solve it in the end—as in it does its job. Instead of to fso.MoveFile
I used Name
and it worked for my purpose. Still unclear why fso.Movefile
didn't work.
The whole code is below if anyone is interested.
Sub loopf()
Dim AcceptedPrefixes As Object
Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
Dim PrefixRange As Range
Set PrefixRange = ThisWorkbook.Sheets(1).Range("a1:a3")
Dim Cell As Range
For Each Cell In PrefixRange.Cells
If Cell <> "" And Not AcceptedPrefixes.exists(Cell.Value) Then
AcceptedPrefixes.Add CStr(Cell.Value), 0
End If
Next
Dim Directory As String
Directory = "C:\TEST\"
Dim fsoFSO
Set fsoFSO = CreateObject("Scripting.FileSystemObject")
Dim filen As Variant
filen = Dir(Directory)
While filen <> ""
Dim FilePrefix As String
FilePrefix = "" & (Split(filen, "_")(0)) & ""
If Not AcceptedPrefixes.exists(FilePrefix) Then
Kill Directory & filen
Else
If fsoFSO.FolderExists("C:\TEST\" & FilePrefix) Then
Name "C:\TEST\" & filen As "C:\TEST\" & FilePrefix & "\" & filen
Else: fsoFSO.CreateFolder ("C:\TEST\" & FilePrefix)
'FSO.MoveFile "C:\TEST\" & filen, "C:\TEST\" & FilePrefix & "\" ---- not working
Name "C:\TEST\" & filen As "C:\TEST\" & FilePrefix & "\" & filen
End If
End If
filen = Dir
Wend
End Sub
Upvotes: 0