PDA

View Full Version : Solved: Multiple files



justdriving
09-15-2011, 12:20 PM
I was trying to use this program to import multiple csv files into a Sheet1 one-after-another.


Private Sub Workbook_Open()
With ActiveSheet.QueryTables.Add(Connection:= "TEXT;C:\1.csv", Destination:=Range("B1"))
.Name = "1"
.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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub


I also wanted to ensure that as soon as 1.csv is imported. It can import A.csv and 99.csv files. I have no idea how to do that?
In Col A, I want to write 1, A and 99 (respective file names) to every cells(row_n, 1).

mancubus
09-15-2011, 01:38 PM
http://www.rondebruin.nl/csv.htm

justdriving
09-15-2011, 10:18 PM
Hi, It could only import files. It can't write filename in Col A.

mancubus
09-16-2011, 02:21 AM
not an elegant one but below may help:


Sub Import_Multiple_CSVs()
'http://www.vbaexpress.com/forum/showthread.php?t=39062

Dim rng As Range
Dim LR As Long, LC As Long
Dim strPath As String, strFile As String
Dim headFound As Boolean

Application.ScreenUpdating = False

strPath = "C:\Data\My_Files\"
If Right(strPath , 1) <> "\" Then
strPath = strPath & "\"
End If

strFile = Dir(strPath & "*.csv")

Range("A2").Value = "CSV File Name"

'import csv files in the same folder
Do While strFile <> ""
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
Destination:=Range("B" & Cells(Rows.Count, "B").End(xlUp).Row + 1))
.Name = Replace(strFile, ".csv", "")
.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 = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1 & ":A" & _
Cells(Rows.Count, "B").End(xlUp).Row) = strFile
strFile = Dir
Loop

'delete data connections
Dim QT As QueryTable
For Each QT In ActiveSheet.QueryTables
QT.Delete
Next QT

'delete blank first row
Rows(1).Delete

'delete imported headings other than first
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B2:B" & LastRow)
headFound = False
headFound = Application.CountIf(rng, Range("B1")) > 0
If headFound Then
For i = LastRow To 2 Step -1
If Range("B" & i).Value = Range("B1").Value Then
Rows(i).EntireRow.Delete
End If
Next
Else
End If

Application.ScreenUpdating = True

End Sub

justdriving
09-17-2011, 03:28 PM
I have three queries: -

In your post # 2, there is program given to choose a folder to open files. Then, it saves output in pre-defined folder using today's date and time, which will unique always. How can I modify this VBA to choose a folder to save output.
If I post this program in Module2, then how can I access this program in Module1?
There is a procedure: Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState).
If I make this procedure Private, then how can I use it in next procedure: Sub Merge_CSV_Files()?

justdriving
09-19-2011, 01:04 PM
This query is awaiting response from other users. I request to help.