User Tools

Site Tools


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)

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki