Gokuba
Gokuba

Reputation: 13

Moving files to a folder, Error 13 Type mismatch

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

Answers (2)

niton
niton

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

Gokuba
Gokuba

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

Related Questions