Dom
Dom

Reputation: 3

Error or cancel handler for GetOpenFilename VBA

Okay so I have a few separate excel files I need merged into one excel file. I have the code to do that and add a header row for sorting purposes. The problem is if I hit cancel on the import it brings me to a debug screen. I would like it to end the function if the user hits cancel. I have tried a few different ways but keep getting a type mismatch with the IF I have commented out. Below is a modification of code I found online. Any help in the right direction would be greatly appreciated. Thank you in advance.

Sub MergeAllWorkbooks()

Call MergeFMDataSelect
Call AddHeaders

End Sub

Sub MergeFMDataSelect()

    Dim SummarySheet As Worksheet, WorkBk As Workbook
    Dim SelectedFiles() As Variant
    Dim FileName As String, FolderPath As String
    Dim NFile As Long, LastRow As Long, NRow As Long
    Dim SourceRange As Range, DestRange As Range
    Application.ScreenUpdating = False

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    'Set SummarySheet = Worksheets("FMData")

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Desktop"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    'ChDir FolderPath

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

    'If SelectedFiles = Cancel Then
        'MsgBox "File not selected to import. Process Terminated"
        'Exit Sub
    'End If**

    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        ' Set the cell in column A to be the file name.
        'SummarySheet.Range("A" & NRow).Value = FileName

        ' Set the source range
        LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", After:=WorkBk.Worksheets(1).Cells.Range("A1"), SearchDirection:=xlPrevious, LookIn:=xlFormulas, SearchOrder:=xlByRows).Row
        Set SourceRange = WorkBk.Worksheets(1).Range("A2:BA" & LastRow)

        ' Set the destination range to start at column a and be the same size as the source range.
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False

    Next NFile
    Application.ScreenUpdating = True

    ' Call AutoFit on the destination sheet so that all data is readable.
    ' SummarySheet.Columns.AutoFit

End Sub

Sub AddHeaders()
Dim headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook

Application.ScreenUpdating = False 'turn this off for the macro to run a little faster

Set wb = ActiveWorkbook

headers() = Array("OBJECTID", "cfeedernum", "clinenum", "cpolenum", "ctaxdist", "clocation", "cregion", "copdist", "czone")

Range("A1").EntireRow.Insert
For Each ws In wb.Sheets
    With ws
    '.Rows(1).Value = "" 'This will clear out row 1
    For i = LBound(headers()) To UBound(headers())
        .Cells(1, 1 + i).Value = headers(i)
    Next i
    .Rows(1).Font.Bold = True
    End With
Next ws

Application.ScreenUpdating = True 'turn it back on

MsgBox ("Done!")

End Sub

Upvotes: 0

Views: 1592

Answers (2)

Voyager
Voyager

Reputation: 1

Application.GetOpenFilename() will throw FALSE to the assigned variable if the window is closed or operation is cancelled. Here is the simple code for error handling...

Sub foo()
    Dim selectedFile As Variant
    selectedFile = Application.GetOpenFilename("All Files,*.*", , "Browse for a file")
    If VarType(selectedFile) = vbBoolean Then
        MsgBox " You either closed the window or cancelled the operation", vbInformation, "File Not selected"
    Else
        MsgBox " Selected file is " + selectedFile, vbInformation, "File Path"
    End If
End Sub

Upvotes: 0

Excelosaurus
Excelosaurus

Reputation: 2849

Declare SelectedFiles As Variant and test If (VarType(SelectedFiles) = vbBoolean) Then to detect the Cancel action.

Upvotes: 1

Related Questions