excel:macro_read_file
This is an old revision of the document!
Excel - Macro Read File
Dim fileToOpen As Variant Dim fileToOpen_name As String Dim FileParts() As String Dim lastrow_InputFile As Long Dim count_InputFile As Double ' Ask user for a file to load. fileToOpen = Application.GetOpenFilename("Excel files (*.xls; *.xlsx; *.csv),*.xls; *.xlsx; *.csv", , "Select file") If fileToOpen = False Then MsgBox "No file selected. No data copied across to the Test sheet." Exit Sub End If FileParts() = Split(fileToOpen, Application.PathSeparator) fileToOpen_name = FileParts(UBound(FileParts)) ' Update StatusBar. Application.StatusBar = "Importing file..." & fileToOpen_name ' Start of copying columns across. With Workbooks.Open(fileToOpen) With .Sheets(1) ' Control to check that the file is in the usual format. If .Range("A2") Like "???????" Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across." Exit Sub End If ' Control to check that the file is in the usual format. If .Range("I2") Like "????" Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Control to check that the file is in the usual format. If WorksheetFunction.CountA(.Range("A1:X1")) = 24 Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Determine how many rows in the input file. lastrow_InputFile = .Cells(Rows.Count, 1).End(xlUp).Row ' Copy all columns from file into master sheet where column names match. For Each my_from_column In .Range("A1:AD1") ' Range is all columns in input file. For Each my_to_column In Workbooks(wb_name).Sheets("Test1").Range("A1:AH1") ' AH is last column containing data from input file. If my_from_column = my_to_column Then .Range(Cells(2, my_from_column.Column), Cells(lastrow_InputFile + 1, my_from_column.Column).End(xlUp)).Copy Workbooks(wb_name).Sheets("Test1").Cells(2, my_to_column.Column) Next my_to_column Next my_from_column ' Counts the number of cells from the input file that should have been copied across. count_InputFile = WorksheetFunction.CountA(.Range("A2:V" & lastrow_InputFile)) End With ' Close the file. Application.DisplayAlerts = False .Close Application.DisplayAlerts = True End With
excel/macro_read_file.1468223619.txt.gz ยท Last modified: 2020/07/15 09:30 (external edit)