Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
The Great Gatsby- Importing multiple external data files
Hi,
I am new to programming in excel so please bear with me. I am trying to write some code to automate the external data import of multiple files. I have recorded the following macro to give me some idea of where to start but i need help on how to finish Here is the code I have With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\otto\Desktop\Pool Volume Data\house1", Destination:= _ Range("A1")) .Name = "house1" <-- This is the name of the file that will change i.e (house1,house2,house3) .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 = True .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub I would like to have a macro that adds a new sheet to the workbook and then loops through each of my files (house1 to house 70). Any help that could be offered would be very much appreciated. Sincerely, Rambo |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
The Great Gatsby- Importing multiple external data files
Try this example
http://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Rambo" wrote in message ... Hi, I am new to programming in excel so please bear with me. I am trying to write some code to automate the external data import of multiple files. I have recorded the following macro to give me some idea of where to start but i need help on how to finish Here is the code I have With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\otto\Desktop\Pool Volume Data\house1", Destination:= _ Range("A1")) .Name = "house1" <-- This is the name of the file that will change i.e (house1,house2,house3) .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 = True .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub I would like to have a macro that adds a new sheet to the workbook and then loops through each of my files (house1 to house 70). Any help that could be offered would be very much appreciated. Sincerely, Rambo |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
The Great Gatsby- Importing multiple external data files
On Jan 24, 10:27*am, "Ron de Bruin" wrote:
Try this examplehttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "Rambo" wrote in ... Hi, I am new to programming in excel so please bear with me. *I am trying to write some code to automate the external data import of multiple files. *I have recorded the following macro to give me some idea of where to start but i need help on how to finish Here is the code I have With ActiveSheet.QueryTables.Add(Connection:= _ * * * *"TEXT;C:\Users\otto\Desktop\Pool Volume Data\house1", Destination:= _ * * * *Range("A1")) * * * *.Name = "house1" *<-- This is the name of the file that will change i.e (house1,house2,house3) * * * *.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 = True * * * *.TextFileTabDelimiter = True * * * *.TextFileSemicolonDelimiter = False * * * *.TextFileCommaDelimiter = False * * * *.TextFileSpaceDelimiter = True * * * *.TextFileColumnDataTypes = Array(1, 1, 1) * * * *.TextFileTrailingMinusNumbers = True * * * *.Refresh BackgroundQuery:=False * *End With End Sub I would like to have a macro that adds a new sheet to the workbook and then loops through each of my files (house1 to house 70). Any help that could be offered would be very much appreciated. Sincerely, Rambo- Hide quoted text - - Show quoted text - Much thanks for this...it works nicely Rambo |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
The Great Gatsby- Importing multiple external data files
Ron, sorry I mixed up my postings.
I used your macro (as shown in code below). So again, removing the header record from each file before bringing it in? Thanks Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Sub ChDirNet(szPath As String) ' Rob Bovey Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path." End Sub Sub Merge_Selected() Dim MyPath As String Dim SourceRcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long Dim SaveDriveDir As String Dim FName As Variant 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With SaveDriveDir = CurDir ChDirNet "C:\Documents and Settings\zandveldd\My Documents\Info Record Change Tool\Vendor Files" FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _ MultiSelect:=True) If IsArray(FName) Then 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) rnum = 1 'Loop through all files in the array(myFiles) For Fnum = LBound(FName) To UBound(FName) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(FName(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next With mybook.Worksheets(1) Set sourceRange = .Range("A1:C1") End With If Err.Number 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all columns then skip this file If sourceRange.Columns.Count = BaseWks.Columns.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceRcount = sourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in column A With sourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = FName(Fnum) End With 'Set the destrange Set destrange = BaseWks.Range("B" & rnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = BaseWks.Cells(rnum, "B"). _ Resize(.Rows.Count, ..Columns.Count) End With destrange.Value = sourceRange.Value rnum = rnum + SourceRcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With ChDirNet SaveDriveDir End Sub "Ron de Bruin" wrote: Change ..TextFileStartRow = 1 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
The Great Gatsby- Importing multiple external data files
See the example avove the first example on the page
http://www.rondebruin.nl/copy3.htm If you want to copy all cells from the sheet or from A2 till the last cell on the sheet. Then replace the code above with this With mybook.Worksheets(1) Set sourceRange = .Range("A2:" & RDB_Last(3, .cells)) End With Note: the code above use the function RDB_Last, copy this function also in your code module if you use it. You find the function in the last section of this page. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "D Zandveld" wrote in message ... Ron, sorry I mixed up my postings. I used your macro (as shown in code below). So again, removing the header record from each file before bringing it in? Thanks Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Sub ChDirNet(szPath As String) ' Rob Bovey Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path." End Sub Sub Merge_Selected() Dim MyPath As String Dim SourceRcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long Dim SaveDriveDir As String Dim FName As Variant 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With SaveDriveDir = CurDir ChDirNet "C:\Documents and Settings\zandveldd\My Documents\Info Record Change Tool\Vendor Files" FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _ MultiSelect:=True) If IsArray(FName) Then 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) rnum = 1 'Loop through all files in the array(myFiles) For Fnum = LBound(FName) To UBound(FName) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(FName(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next With mybook.Worksheets(1) Set sourceRange = .Range("A1:C1") End With If Err.Number 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all columns then skip this file If sourceRange.Columns.Count = BaseWks.Columns.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceRcount = sourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in column A With sourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = FName(Fnum) End With 'Set the destrange Set destrange = BaseWks.Range("B" & rnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = BaseWks.Cells(rnum, "B"). _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value rnum = rnum + SourceRcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With ChDirNet SaveDriveDir End Sub "Ron de Bruin" wrote: Change ..TextFileStartRow = 1 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Importing data from multiple excel files | Excel Discussion (Misc queries) | |||
Importing External Data From Several Files | Excel Discussion (Misc queries) | |||
Importing pieces of data from multiple files | Excel Programming | |||
Need advice : consolidating data from multiple CSV files in Excel - External data handling | Excel Programming | |||
Importing Multiple Data Files | Excel Programming |