2015-02-25 1 views
0

У меня есть код VBA (Excel 2010). Импортирует несколько файлов csv и вставляет их в разные листы. Но он не импортирует данные в текущую книгу, откуда выполняется код. Это скорее открывает новую книгу и выполняет эту работу.Я хочу, чтобы этот код VBA запускался из командной кнопки в текущей книге

Я хочу, чтобы иметь возможность запускать этот код с помощью кнопки Command и импортировать данные в активную книгу.

Любые предложения, какие изменения я должен включить?

Ваш совет очень ценится.

Sub CombineTextFiles() 
    Dim FilesToOpen 
    Dim x As Integer 
    Dim wkbAll As Workbook 
    Dim wkbTemp As Workbook 
    Dim sDelimiter As String 
On Error GoTo ErrHandler 
    Application.ScreenUpdating = False 
sDelimiter = "|" 
FilesToOpen = Application.GetOpenFilename _ 
     (FileFilter:="Text Files (*.csv), *.csv", _ 
     MultiSelect:=True, Title:="Text Files to Open") 
If TypeName(FilesToOpen) = "Boolean" Then 
     MsgBox "No Files were selected" 
     GoTo ExitHandler 
    End If 
x = 1 
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
    wkbTemp.Sheets(1).Copy 
    Set wkbAll = ActiveWorkbook 
    wkbTemp.Close (False) 
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _ 
     Destination:=Range("A1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, _ 
     ConsecutiveDelimiter:=False, _ 
     Tab:=False, Semicolon:=False, _ 
     Comma:=False, Space:=False, _ 
     Other:=True, OtherChar:="|" 
    x = x + 1 
While x <= UBound(FilesToOpen) 
     Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
     With wkbAll 
      wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count) 
      .Worksheets(x).Columns("A:A").TextToColumns _ 
       Destination:=Range("A1"), DataType:=xlDelimited, _ 
       TextQualifier:=xlDoubleQuote, _ 
       ConsecutiveDelimiter:=False, _ 
       Tab:=False, Semicolon:=False, _ 
       Comma:=False, Space:=False, _ 
       Other:=True, OtherChar:=sDelimiter 
     End With 
     x = x + 1 
    Wend 
ExitHandler: 
    Application.ScreenUpdating = True 
    Set wkbAll = Nothing 
    Set wkbTemp = Nothing 
    Exit Sub 
ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 
End Sub 

ответ

0

Это wbkTemp.Sheets(1).Copy, что это проблема: если вы не provde либо дополнительных параметров Before или After, Excel создает копию в новой книге (см Примечания здесь https://msdn.microsoft.com/en-us/library/office/ff837784.aspx).

Вам нужно будет установить ссылку на инициирующее учебное пособие ранее - изменить код вокруг открытия первого CSV следующим образом:

Set wkbAll = ActiveWorkbook 'moved from a few lines lower down 
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) 
wbkTemp.Sheets(1).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count) 

Вы должны внести соответствующие изменения в последующие методы копирования

+0

Привет @MarkWickett, я попытался с помощью предложенных вами изменений, но макро выходит, что дает мне сообщение об ошибке «Автоматизация». Он не показывает, где происходит ошибка. –

+0

Хорошо - не знаю, почему вы это понимаете, но я заметил, что после того, как вы откроете CSV, это станет ActiveWorkbook, поэтому попытка скопировать то, что новый лист сам по себе не будет работать. Я отредактировал свой ответ выше, чтобы отразить более точное решение! –

+0

Кроме того, ваша обработка ошибок может мешать вам сообщить, где ошибка: просто закомментируйте «On Error Goto ErrHandler», а затем вы должны получить возможность отлаживать заявление о нарушении, если появляется всплывающее сообщение. Конечно, раскомментируйте это, когда он работает :-) –

0

Я нашел эту ссылку полезной.

Import multiple text files

Он работал в моем случае, с той лишь разницей, что я должен был бы выбрать конкретную папку, содержащую все необходимые файлы, а не сами отдельные файлы.

Он также будет работать только текстовые файлы из-за опцией Workbooks.OpenText FileName

Надеется, что это помогает, кто сталкивается с подобными проблемами тоже.

С уважением asar_k

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