2017-10-17 34 views
0

好吧,我有幾個獨立的excel文件需要合併到一個excel文件中。我有代碼來做到這一點,並添加一個標題行進行排序。問題是如果我點擊取消導入它將我帶到調試屏幕。如果用戶點擊取消,我希望它結束​​該功能。我已經嘗試了幾種不同的方法,但仍然與我已經註釋過的IF不匹配。以下是我在網上找到的代碼的修改。任何幫助正確的方向將不勝感激。先謝謝你。GetOpenFilename VBA的錯誤或取消處理程序

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 

回答

0

聲明SelectedFiles As Variant和測試If (VarType(SelectedFiles) = vbBoolean) Then檢測取消行動。

+0

此答案已被「拒絕」;解釋將不勝感激。 – Excelosaurus