我想通过使用WorkbookConnection.AddfromFile将csv文件与excels power pivot与VBA代码连接
我的问题：
我想连接多个csv文件。为此，我必须通过文本导入向导单击几个小时。我还没有发现如何自动化这个！我想用类似的方式来做，就像我在我的代码上部用FileDialog做的那样。在我想要实现它的代码部分下面。
For LoopCounter = 1 To fd.SelectedItems.count
ActiveWorkbook.Connections.AddFromFile _
fd.SelectedItems(LoopCounter), True, False
Next LoopCounter
在我已编写的代码下面。使用此代码，我必须手动单击TextImportWizard。
Sub csv()
Dim fd As FileDialog
Dim ActionClicked As Boolean
Dim LoopCounter As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "C:\temp"
fd.AllowMultiSelect = True
fd.Title = "Open your data"
fd.ButtonName = "GO"
ActionClicked = fd.Show
If ActionClicked Then
For LoopCounter = 1 To fd.SelectedItems.count
ActiveWorkbook.Connections.AddFromFile _
fd.SelectedItems(LoopCounter), True, False
Next LoopCounter
Else
MsgBox "You didn't choose anything"
Exit Sub
End If
End Sub
答案 0 :(得分：0)
导入CSV或文本文件的更快方法是使用以下
Dim SortStr As Variant
Dim SortNum As Long
'change below array as per your requirement
SortStr = Array("Open", "in progress", "almost finished")
Application.AddCustomList ListArray:=SortStr
SortNum = Application.CustomListCount
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Range("B1"), xlSortOnValues, xlAscending, SortNum
ActiveSheet.Sort.SortFields.Add Range("A1"), xlSortOnValues, xlDescending
With ActiveSheet.Sort
.SetRange Range(Data)
.Header = xlGuess
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.DeleteCustomList Application.CustomListCount
如果你想为文件夹中的所有CSV文件自动化它，我建议你循环浏览档案 - 查看.csv文件 - 这里有一个关于如何开始使用的示例：
Dim InputStringCSV As String
Dim CSVFile As Variant
Dim ArrayStringCSV() As String
CSVFile = Application.GetOpenFilename("CSV Files,*.CSV", Title:="MyData")
If CSVFile = False Then "No input!", vbCritical: End
Open CSVFile For Input As #1
Do Until EOF(1)
Line Input #1, InputStringCSV
ArrayStringCSV = Split(InputStringCSV, Chr(10))
For CounterArray = LBound(ArrayStringCSV) To UBound(ArrayStringCSV)
'Defaults: Row 1 is the beginnning for the sheet
Sheets(Sheet_CSV).Cells(1 + CounterArray, 1).NumberFormat = "@"
Sheets(Sheet_CSV).Cells(1 + CounterArray, 1) = ArrayStringCSV(CounterArray)
Next CounterArray
Loop
Close #1
答案 1 :(得分：0)
有很多方法可以导入文本文件。请参阅以下链接。
http://www.rondebruin.nl/win/s3/win022.htm
此AddIn将为您完成工作。
http://www.rondebruin.nl/win/addins/rdbmerge.htm
此外，您可以将文件夹中的所有文本文件合并到一个工作表中。
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
#Else
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
#End If
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103
Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub
Sub Merge_CSV_Files()
Dim BatFileName As String
Dim TXTFileName As String
Dim XLSFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim DefPath As String
Dim Wb As Workbook
Dim oApp As Object
Dim oFolder
Dim foldername
'Create two temporary file names
BatFileName = Environ("Temp") & _
"\CollectCSVData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat"
TXTFileName = Environ("Temp") & _
"\AllCSV" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt"
'Folder where you want to save the Excel file
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Set the extension and file format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007 or higher
FileExtStr = ".xlsx": FileFormatNum = 51
'If you want to save as xls(97-2003 format) in 2007 use
'FileExtStr = ".xls": FileFormatNum = 56
End If
'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr
'Browse to the folder with CSV files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with CSV files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If
'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*.csv" _
& Chr(34) & " " & TXTFileName
Close #1
'Run the Bat file to collect all data from the CSV files into a TXT file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no csv files in this folder"
Kill BatFileName
Exit Sub
End If
'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False
'Save text file as a Excel file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
Application.DisplayAlerts = True
Wb.Close savechanges:=False
MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName
'Delete the bat and text file you temporary used
Kill BatFileName
Kill TXTFileName
Application.ScreenUpdating = True
End If
End Sub
你会在这里找到更多信息。