2012-08-28 24 views
13

¿Cómo hago esto? Básicamente, quiero que mis múltiples archivos CSV se importen a múltiples hojas de trabajo, pero solo en un solo libro de trabajo. Aquí está mi código de VBA que quiero hacer un bucle. Necesito el bucle para consultar toda la CSV en C:\test\Importación de varios archivos CSV a varias hojas de cálculo en un solo libro de trabajo

Sub Macro() 
With ActiveSheet.QueryTables.Add(Connection:= _ 
    "TEXT;C:\test\test1.csv", Destination:=Range("$A$1")) 
    .Name = "test1" 
    .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(1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
Sheets.Add After:=Sheets(Sheets.Count) 
End Sub 

Respuesta

0

No he intentado esto, pero me gustaría ir con this:

Dim NumFound As Long 
With Application.FileSearch 
    .NewSearch 
    .LookIn = "C:\test\" 
    .FileName = "*.csv" 
    If .Execute() > 0 Then 
     For i = 1 To .FoundFiles.Count 
      With ActiveSheet.QueryTables.Add(Connection:= _ 
       "TEXT;" & "C:\test\" & (Application.FileSearch.FoundFiles(i)), Destination:=Range("$A$1")) 
       ... 
      End With 
      Sheets.Add After:=Sheets(Sheets.Count) 
     Next i 
    End If 
End With 
+0

'Application.FileSearch' está desfasada y en Office 2007 por lo que este es unlikley para ser adecuado – brettdj

5

cuidado, esto no se ocupa de los errores como lo haría tener un nombre de hoja duplicado si importó un csv.

Esto utiliza enlace anticipado por lo que necesita hacer referencia Microsoft.Scripting.Runtime bajo Tools..References en el VBE

Dim fs As New FileSystemObject 
Dim fo As Folder 
Dim fi As File 
Dim wb As Workbook 
Dim ws As Worksheet 
Dim sname As String 

Sub loadall() 
    Set wb = ThisWorkbook 

    Set fo = fs.GetFolder("C:\TEMP\") 

    For Each fi In fo.Files 
     If UCase(Right(fi.name, 4)) = ".CSV" Then 
      sname = Replace(Replace(fi.name, ":", "_"), "\", "-") 

      Set ws = wb.Sheets.Add 
      ws.name = sname 
      Call yourRecordedLoaderModified(fi.Path, ws) 
     End If 
    Next 
End Sub 

Sub yourRecordedLoaderModified(what As String, where As Worksheet) 
With ws.QueryTables.Add(Connection:= _ 
    "TEXT;" & what, Destination:=Range("$A$1")) 
    .name = "test1" 
    .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(1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
Sheets.Add After:=Sheets(Sheets.Count) 
End Sub 
+1

Creo que va a estar bien ya que los nombres de archivo son únicos. – Dumont

3

Se puede utilizar para filtrar Dir y correr con sólo los archivos csv

Sub MacroLoop() 
Dim strFile As String 
Dim ws As Worksheet 
strFile = Dir("c:\test\*.csv") 
Do While strFile <> vbNullString 
Set ws = Sheets.Add 
With ws.QueryTables.Add(Connection:= _ 
    "TEXT;" & "C:\test\" & strFile, Destination:=Range("$A$1")) 
    .Name = strFile 
    .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(1, 1, 1, 1, 1) 
    .TextFileTrailingMinusNumbers = True 
    .Refresh BackgroundQuery:=False 
End With 
strFile = Dir 
Loop 
End Sub 
+0

El nombre de la hoja de trabajo no refleja el nombre del archivo CSV para este código. ¿Cómo lo resuelvo? – Dumont

+0

Ya resolví el nombre de archivo de la hoja de trabajo. Mi nuevo problema es que me estoy quedando sin memoria. Estoy importando alrededor de 80 archivos CSV. – Dumont

+0

@Dumont Sobre el nombre del archivo, supongo que ves que utilicé una variable. En su error de memoria, ¿cuántos CSV está importando? ¿El otro código que aceptaba funciona dado que usa el mismo método de importación (pero prueba primero cada tipo de archivo) – brettdj

10

This guy absolutamente clavado. Un código muy conciso y funciona perfectamente para mí en 2010. Todo el mérito recae en él (Jerry Beaucaire). Lo encontré de un foro here.

Option Explicit 
Sub ImportCSVs() 
'Author: Jerry Beaucaire 
'Date:  8/16/2010 
'Summary: Import all CSV files from a folder into separate sheets 
'   named for the CSV filenames 

'Update: 2/8/2013 Macro replaces existing sheets if they already exist in master workbook 

Dim fPath As String 
Dim fCSV As String 
Dim wbCSV As Workbook 
Dim wbMST As Workbook 

Set wbMST = ThisWorkbook 
fPath = "C:\test\"     'path to CSV files, include the final \ 
Application.ScreenUpdating = False 'speed up macro 
Application.DisplayAlerts = False 'no error messages, take default answers 
fCSV = Dir(fPath & "*.csv")   'start the CSV file listing 

    On Error Resume Next 
    Do While Len(fCSV) > 0 
     Set wbCSV = Workbooks.Open(fPath & fCSV)     'open a CSV file 
     wbMST.Sheets(ActiveSheet.Name).Delete      'delete sheet if it exists 
     ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr 
     Columns.Autofit    'clean up display 
     fCSV = Dir     'ready next CSV 
    Loop 

Application.ScreenUpdating = True 
Set wbCSV = Nothing 
End Sub 
+0

Esto no parece funcionar con 2013 (a menos que me falta algo.) Copié este script en un libro de Excel habilitado para macros (2013) y lo ejecuté (con dos .csv archivos en el directorio especificado). Cuando lo ejecuté, abrió dos nuevas instancias de Excel (dos nuevos libros de trabajo) con una única hoja de trabajo en cada una, y nada en mi libro de trabajo original. ¿El script necesita ser actualizado? – kmote

+0

No es probable que tenga tiempo para investigar, lo siento. Por favor, siéntase bienvenido a dar una respuesta actualizada. –

Cuestiones relacionadas