2014-09-09 4 views
0

C Уважаемый SO-сообществоавтоматического импорта (ежедневно, CSV и XLS -> XLS (м))

я получил следующую проблему/задачу:

мне нужно автоматически и ежедневно импорт некоторые данные в один «master-xls». Как исходные данные, так и консолидированные данные организованы в одной структуре (см. Примеры ниже).

Возможно ли в любом случае - с VBA (предпочтительно) или без VBA - автоматически импортировать данные из исходные файлы (имя файла представляет собой комбинацию строки и фактической даты) в «файл назначения»

Помощь и советы очень ценятся! Plz направляет меня в правильное направление вместо представления уже работающего примера.

Важно, чтобы данные из нового исходного файла были добавлены к уже имеющимся данным!

наилучшими пожеланиями, Лука

исходные файлы:
* source 1
* source 2

мастер файл
* master xls

ответ

0

Мне удалось автоматизировать импорт 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 
0

Я собираюсь направить вас в правильном направлении, предполагая, что я правильно вас понимаю.

Если вы открываете и хотите читать из таблицы 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 значение в качестве отправной точки для вставки.

Как и в сторону,

«Помощь и советы очень ценятся! Plz не потрудился мне точку в правильном направлении ...»

^не очень хорошая вещь сказать вокруг этих частей. Особенно, когда вы только что сказали: «Я ценю вашу помощь, но, пожалуйста, не беспокойтесь, помогая мне».

Получайте удовольствие от этого.

Смежные вопросы