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

Question

C亲爱的苏-社区

我有以下问题/挑战：

我需要自动和每日导入一些数据到一个“主人-xls”。源数据和合并数据都组织在相同的结构中(请参阅下面的示例)。

无论是使用VBA (更好的)还是不使用VBA，是否有可能将数据从源文件(文件名是字符串和实际日期的组合)自动导入到“目标文件”中？

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

重要的是，来自新源文件的数据被附加到已经存在的数据中！

最美好的祝愿，卢克

源文件：

*来源1

*来源2

主文件

*师父xls

Answer 1

我终于实现了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

Answer 2

如果我对你的理解是正确的，我会给你指明正确的方向。

如果您正在打开并希望从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值作为插入的起点。

作为旁人，

“非常感谢你的帮助和建议！请不要费心把我引向正确的方向.”

一般说来，在这些地方说并不是一件好事。尤其是当你说“我很感谢你的帮助，但请不要费心帮助我。”

玩得开心点。