自动导入(每日，csv & xls --> xls(m))

Question

C尊敬的SO社区

我遇到以下问题/挑战：

我需要每天自动将一些数据导入到一个"主xls"中。源数据和合并数据都以相同的结构组织（请参阅以下示例）

是否有可能（使用VBA（首选）或不使用VBA）将源文件中的数据（文件名是字符串和实际日期的组合）自动导入"目标文件"

非常感谢您的帮助和提示！请给我指出正确的方向，而不是给出一个已经在工作的例子。

重要的是，将新源文件中的数据附加到已存在的数据中！

致以最良好的祝愿，Luke

源文件：
*来源1
*来源2

主文件
*主xls

Answer 1

假设我正确理解你，我将为你指明正确的方向。

如果你正在打开并想从Excel电子表格中阅读，这将很有用：

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
'Set up the Connection to Excel
Set cnn = New ADODB.Connection
With cnn
    .Provider = "Microsoft.ACE.OLEDB.12.0" 'or whatever your provider is
    .ConnectionString = "Data Source="C:My_source_file.xlsx';Extended Properties='Excel 12.0 Xml;HDR=NO;IMEX=1';"
    .Open
End With
'Set up the command to get all that mess out the spreadsheet.
Set cmd = New ADODB.Command
With cmd
    .ActiveConnection = cnn
    .CommandText = "SELECT * FROM [WhateverSheetHasMyData$]"
End With
'Load up the recordset with everything in the worksheet.
Set rst = New ADODB.Recordset
With rst
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open cmd
End With 

这应该会让你朝着你想要的方向前进。我相信你可以从中推断出，你也可以使用命令将你加载的数据存入其他文档，比如另一个电子表格或数据库表。

此外，当涉及到附加信息时，Excel有一个漂亮的东西：

...
Dim ws As Excel.Worksheet
Dim lastrow As Integer
Set ws = wb.Sheets(1) 'wb being your workbook object; you could also use the sheet name instead of the index here
ws.Activate
lastrow = ws.Cells.SpecialCells(11).Row 'gets you the last row

因此，您可以使用lastrow+1值作为插入的起点。

顺便说一句，

"非常感谢您的帮助和提示！请不要麻烦我指出正确的方向…"

^一般来说，对这些部分来说不是一件好事。尤其是当你刚刚说"我感谢你的帮助，但请不要麻烦帮助我。"

玩得开心。

Answer 2

我终于实现了csv导入的自动化。解决方案的某些部分最初可在此处找到：http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/

以下是我的解决方案：

Sub listfiles_dir()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim lastrow As Integer
Dim lastcolumn As Integer
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim header As Boolean
header = True
Set wb = ActiveWorkbook
Set ws = wb.Sheets("raw")
ws.Activate
ws.Cells.ClearContents
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
'Set objFolder = objFSO.GetFolder(".data")
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "data")

i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    'Cells(i + 1, 1) = objFile.Name
    'print file path
    'Cells(i + 1, 2) = objFile.Path
    i = i + 1
    Debug.Print (objFile.Path)
    If header = True Then
        lastrow = 5
    Else
        lastrow = ws.Range("A" & Rows.Count).End(xlUp).row + 1 'gets you the last row
    End If
    Call import_csv(ws, objFile.Path, header, lastrow)
    lastcolumn = ws.Range("$A$" & CStr(lastrow)).End(xlToRight).Column + 1
    Cells(lastrow, lastcolumn) = objFile.Name
    Debug.Print (lastcolumn)
    If header = True Then
        header = False
    End If
Next objFile
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

'import files

Sub import_csv(sheet As Worksheet, fname As String, header As Boolean, row As Integer)
'
' importCSV Macro
'
Dim startingrow As Integer
startingrow = 1
If header = False Then
    startingrow = 2
End If
Debug.Print ("$A$" & CStr(row))

With sheet.QueryTables.Add(Connection:= _
    "TEXT;" & fname, Destination:=Range( _
    "$A$" & CStr(row)))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    '.PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    '.SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFileStartRow = startingrow
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
End Sub