I'm trying to open all the files in my folder and then copy the data from the files and add them into a single worksheet, close the file, and then move them into a new folder. I'm fairly new to VBA and this is what I have so far: Opening the dialogue box and selecting the folder, open the workbook and then close the workbook. However, when the code proceeds to open the workbooks my excel just glitches and is frozen. Please help.

Sub OpenFilesinFolderModWorkingDoc()

'create reference workbook variables


Dim FolderPath As String    'path of folder
Dim CPath As String 'path for current workbooks
Dim CName As String 'name for current workbooks
Dim DiaFolder As FileDialog
Dim mwb As Workbook 'individual workbooks


'Turn off settings
Application.ScreenUpdating = False

'File Dialogue
 Set DiaFolder = Application.FileDialog(msoFileDialogFolderPicker)
 DiaFolder.AllowMultiSelect = False
 DiaFolder.Show
 FolderPath = DiaFolder.SelectedItems(1)

CPath = FolderPath & "\" ' location of files
CName = Dir(CPath & "*.xlsx")

'loop through files in folder

Do While CName <> "" 'Loop through all files in selected folder
Set mwb = Workbooks.Open(CPath & "\" & CName)
mwb.Close True
Loop
End Sub

CodePudding user response：

Just some food for thought, I've done something similar in the past, but it was with Power Query in Excel (Data - Queries & Connections), not sure if that is an option for you or not. It can combine multiple files into one and then using Power Automate you can move the files to another directory.

-Rob

CodePudding user response：

I actually tried your exact code on my machine and it happened to glitch out also which surprised me as the code looks ok. I slowed it down and I think it might have been due to the file being stored on oneDrive (MS cloud) vs. having it saved on my local hard drive.

The issue with mine was that it kept trying to save instantly which is the behavior when on one drive as it saves in real time.

Try testing on a local directory perhaps in downloads or any folder that isn't synced with Microsoft OneDrive.

CodePudding user response：

Loop Through the Files (Dir) of a Selected Folder (FileDialog)

Sub ImportDataFromMod()
    
    ' Define constants.
    
    Const PROC_TITLE As String = "Import Data From Mod"
    Const SRC_FILE_PATTERN As String = "*.xlsx"
    
    ' Select the Source folder.
    
    Dim pSep As String: pSep = Application.PathSeparator
    
    Dim fodg As FileDialog
    Set fodg = Application.FileDialog(msoFileDialogFolderPicker)
    
    Dim sFolderPath As String
    
    If fodg.Show Then ' OK
        sFolderPath = fodg.SelectedItems(1)
    Else ' Cancel
        MsgBox "No folder selected.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    If Right(sFolderPath, 1) <> pSep Then sFolderPath = sFolderPath & pSep
    
    ' Get the first file name.
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & SRC_FILE_PATTERN)
    
    If Len(sFileName) = 0 Then
        MsgBox "No files found in '" & sFolderPath & "'.", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
'    ' Reference the Destination objects (Copy Data Example).
'
'    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
'    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1")
'    Dim dfCell As Range
'    Set dfCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
    
    ' Copy the data...
    
    ' Turn off settings.
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
'    ' Continue (Copy Data Example).
'    Dim sws As Worksheet
'    Dim srg As Range
    
    Do While Len(sFileName) > 0
        Set swb = Workbooks.Open(sFolderPath & sFileName)
        
        ' Print the file names in the Immediate window (Ctrl G).
        Debug.Print swb.Name
        
'        ' Continue (Copy Data Example).
'        Set sws = swb.Sheets("Sheet1")
'        With sws.UsedRange
'            Set srg = .Resize(.Rows.Count - 1).Offset(1) ' exclude headers
'        End With
'        srg.Copy dfCell ' copy
'        Set dfCell = dfCell.Offset(srg.Rows.Count) ' next destination cell
        
        swb.Close SaveChanges:=False ' don't save, they are just read from
        sFileName = Dir ' next file
    Loop

    ' Turn on settings.
    Application.ScreenUpdating = True
    
    ' Inform.
    
    MsgBox "Data imported.", vbInformation, PROC_TITLE

End Sub