Question

Ç 亲爱的SO社区

我遇到了以下问题/挑战：

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

无论是哪种方式 - 使用VBA（首选）或不使用VBA，都可以自动将源文件中的数据（文件名是字符串和实际日期的组合）导入到＆＃34;目标文件＆＃34;

非常感谢帮助和提示！ Plz指出了我正确的方向，而不是展示一个已经有效的例子。

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

最好的祝福，路加

源文件：
* source 1
* source 2

主文件
* master 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值作为插入的起点。

顺便说一下，

＆＃34;非常感谢帮助和提示！ Plz不打算指引我走向正确的方向......＆＃34;

^围绕这些部分说一般不是一件好事。特别是当你刚才说'我感谢你的帮助，但请不要帮助我。＆＃34;

玩得开心。

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

自动导入（每日，csv＆amp; xls - ＆gt; xls（m））

2 个答案: