Jestem nowy w VBA Macro Chcę, aby makro stworzyć folder (podfolder), a następnie przesuwa cały plik do nowo utworzonego folderu.

Moje kody

Sub create_move()

'Variable declaration
    Dim sFolderName As String, sFolder As String
    Dim sFolderPath As String, oFSO As Object
    Dim fromdir As String
    Dim todir As String
    Dim flxt As String
    Dim fname As String
    Dim fso As Object
       
    'Main Folder
    sFolder = "C:\Main\" 'Main Folder where macro excel is present
    
    'Folder Name
    sFolderName = "POL & POD Files" & " " & "-" & " " & Format(Now, "DD-MM-YYYY")
    
    'Folder Path
    sFolderPath = "C:\NewFolder\" & sFolderName 'New Folder
        
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir sFolderPath
    
'Move files

fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"

todir = "sFolderName" & "sFolderPath" ' Newly created folder name and path

flxt = "*.xlsx"

fname = Dir(fromdir & flxt)

 If Len(fname) = 0 Then
 MsgBox "All Excel Files Moved" & fromdir
 
Exit Sub
End If


Set fso = CreateObject("Scripting.FileSystemObject")

fso.MoveFile Source:=fromdir & flxt, Destination:=todir

End Sub

To makro tworzy folder, ale nie przesuwa plików w niej Uzyskaj błąd czasu pracy 76 Nie znaleziono ścieżki. Kiedy debuguję, otrzymuję błąd na tej linii {x0}}

Mój pomysł był najpierw utworzyć nowy folder, więc za to, że wprowadziłem początkowe kodowanie, aby utworzyć nowy folder, a następnie przesunąć pliki w tym nowo utworzonym folderze, więc dałem "imię zmiennej i ścieżki, którą użyłem, aby stworzyć Folder "Ale to nie działa ten kod tworzenie nowego folderu, ale nie przenoszenie plików w nich i otrzymanie błędu w tej linii" FSO

Some1 proszę o pomoc ....

0
Jazz 18 październik 2020, 15:56

1 odpowiedź

Najlepsza odpowiedź

Spróbuj tego:

Option Explicit

Sub create_move2()
    'Variable declaration
    Dim oFSO As Object
    Dim curFile As Variant
    Dim fromdir As String
    Dim todir As String
    Dim fileExt As String
           
    fromdir = "C:\Users\chariab\Desktop\POL-POD AutoExp\Extracted Files\"
    todir = "C:\NewFolder\POL & POD Files - " & Format(Now, "DD-MM-YYYY") & "\"

    fileExt = "xlsx"  'move files with file extension
            
    'Create FSO Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    'Create Folder
    MkDir todir
    
    For Each curFile In oFSO.GetFolder(fromdir).Files  'loop thru each file in fromdir

        
        If Right(CStr(curFile.name), len(fileExt)) = fileExt Then        'move file if it matches
            Debug.Print "moving " & curFile.name
            curFile.Move todir
        End If
    Next curFile
    
    If Dir(todir & "\*." & fileExt) <> "" Then 'check and see if files moved
        MsgBox "moved files to " & todir
    Else
        MsgBox "no files moved"
    End If
    
    Set oFSO = Nothing
    
End Sub




0
AllegriG 19 październik 2020, 12:35