2017-02-09 6 views
0

Я использовал код ниже, но заметил, что он отбрасывает ведущие 0.Слияние текстовых файлов из папки VBA

Я попытался изменить код на .OpenText и получить ошибку

«Ожидаемую функция или переменная».

Файлы, которые загружаются, являются CSV-файлами, преобразованными в .txt перед открытием с использованием пакетного скрипта.

Sub ExcelFileMerger() 
Dim bookList As Workbook 
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Set mergeObj = CreateObject("Scripting.FileSystemObject") 

'change folder path of excel files here 
Set dirObj = mergeObj.Getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files") 
Set filesObj = dirObj.Files 
For Each everyObj In filesObj 
'This is what I have tried changing to .OpenText and get returned error "Expected Function or variable" 
Set bookList = Workbooks.Open(everyObj) 


'change "A2" with cell reference of start point for every files here 
'for example "B3:IV" to merge all files start from columns B and rows 3 
'If you're files using more than IV column, change it to the latest column 
'Also change "A" column on "A65536" to the same column as start point 
Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy 
ThisWorkbook.Worksheets(1).Activate 
'Do not change the following column. It's not the same column as above 
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial  Paste:=xlPasteFormulasAndNumberFormats 
Application.CutCopyMode = False 
bookList.Close 

Вот код, который я получил после записи макроса. Теперь я пытаюсь выяснить, как сетка на 2.

With ActiveSheet.QueryTables.Add(Connection:= _ 
    "TEXT;R:\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files\product_export1.txt" _ 
    , Destination:=Range("$A$1")) 
    .CommandType = 0 
    .Name = "product_export1" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .TextFilePromptOnRefresh = False 
    .TextFilePlatform = 437 
    .TextFileStartRow = 1 
    .TextFileParseType = xlDelimited 
    .TextFileTextQualifier = xlTextQualifierDoubleQuote 
    .TextFileConsecutiveDelimiter = False 
    .TextFileTabDelimiter = False 
    .TextFileSemicolonDelimiter = False 
    .TextFileCommaDelimiter = True 
    .TextFileSpaceDelimiter = False 
    .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
+0

https://msdn.microsoft.com/en -us/library/office/ff194819.aspx, попробуйте 'Set bookList = Workbooks.Open (everyObj, Format: = 4)' to force ';' как разделитель или 'Set bookList = Workbooks.OpenText (everyObj, точка с запятой: = True) ' – R3uK

+0

По-прежнему бросая ведущие 0 и меняя ску на даты и т. Д. Если я смогу найти способ импортировать первый столбец в виде текста, это было бы оптимально, я думаю. – Charles

+2

Вы можете активировать свой макрорекордер, импортировать CSV в качестве данных из текста, установить кодировку и весь этот джаз и * указать каждый тип данных столбцов *, закончить, остановить макросъемку. Использовать записанный макрос в качестве основы. – LocEngineer

ответ

1

ОК, вот сетка из ваших двух, немного скорректированы:

Sub ExcelFileMerger() 
Dim bookList As Workbook 
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
Dim con As String 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Set mergeObj = CreateObject("Scripting.FileSystemObject") 

'change folder path of excel files here 
Set dirObj = mergeObj.getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files") 
Set filesObj = dirObj.Files 
For Each everyObj In filesObj 
    Set bookList = Workbooks.Add 
    con = "TEXT;" & everyObj 
    With bookList.Sheets(1).QueryTables.Add(Connection:= _ 
     con, Destination:=Range("$A$1")) 
     .Name = "product_export1" 
     .FieldNames = True 
     .RowNumbers = False 
     .FillAdjacentFormulas = False 
     .PreserveFormatting = True 
     .RefreshOnFileOpen = False 
     .RefreshStyle = xlInsertDeleteCells 
     .SavePassword = False 
     .SaveData = True 
     .AdjustColumnWidth = True 
     .RefreshPeriod = 0 
     .TextFilePromptOnRefresh = False 
     .TextFilePlatform = 437 
     .TextFileStartRow = 1 
     .TextFileParseType = xlDelimited 
     .TextFileTextQualifier = xlTextQualifierDoubleQuote 
     .TextFileConsecutiveDelimiter = False 
     .TextFileTabDelimiter = False 
     .TextFileSemicolonDelimiter = False 
     .TextFileCommaDelimiter = True 
     .TextFileSpaceDelimiter = False 
     .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _ 
     , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 
     1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) 
     .TextFileTrailingMinusNumbers = True 
     .Refresh BackgroundQuery:=False 
    End With 

    'change "A2" with cell reference of start point for every files here 
    'for example "B3:IV" to merge all files start from columns B and rows 3 
    'If you're files using more than IV column, change it to the latest column 
    'Also change "A" column on "A65536" to the same column as start point 
    Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy 
    ThisWorkbook.Worksheets(1).Activate 
    'Do not change the following column. It's not the same column as above 
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats 
    Application.CutCopyMode = False 
    bookList.SaveAs "GiveItAPathAndFilenameHere" 
    bookList.Close 
Next 
End Sub 
+0

Могу ли я изменить .Name = "product_export1" на .Name = "everyObj"? Это работает, хотя у меня все еще есть проблемы с форматированием, но я могу понять это. Итак, вы создали переменную con, присвоенную ей текстовым значением и объединив ее с everyobj? Затем сделал bookList.Sheets для вызова в файл? Спасибо за вашу помощь! – Charles

+1

Да, 'con' содержит ключевое слово TEXT; за которым следует путь к файлу. Для .Name я предпочел бы использовать '.Name = mergeObj.GetFileName (everyObj)'. Это должно дать вам имя файла без пути. 'bookList.Sheets (1)' заменяет ÀctiveSheet' из макроса, чтобы сохранить его переменной. – LocEngineer

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