Question

目前我正在使用一个宏分别将一个文件同时导入到一个工作表中，如果我可以打开该文件夹中的所有文件并将它们一次导入一个工作表，这样会更方便节省了很多时间，你有什么建议我应该修改它，我对这个很无能为力。

Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _
  (FileFilter:="Text Files (*.mef3), *.mef3", _
  MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If

x = 1
Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
  Destination:=Range("A1"), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, _
  Tab:=False, Semicolon:=False, _
  Comma:=False, Space:=False, _
  Other:=True, OtherChar:="|"
x = x + 1

While x <= UBound(FilesToOpen)
    Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
    With wkbAll
        wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
        .Worksheets(x).Columns("A:A").TextToColumns _
          Destination:=Range("A1"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, _
          ConsecutiveDelimiter:=False, _
          Tab:=False, Semicolon:=False, _
          Comma:=False, Space:=False, _
          Other:=True, OtherChar:=sDelimiter
    End With
    x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

一次将一个文件夹中的多个文件导入单个工作簿

0 个答案: