![]() |
Importing many text files into one excel worksheet - how to?
Hi all,
I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Scott
Below each other or next to each other ? We can change this one to copy in the same sheet http://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Ron,
The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Oh, and I forgot to mention (not that it's a big thing). Rather than
a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Scott
Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Ron,
This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Scott
B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Ron,
Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Tru this sub then
Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Ron,
For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Remove this line
On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message oups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Ron,
Unfortunately still no luck. Scott. Ron de Bruin wrote: Remove this line On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message oups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
No errors ?
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message oups.com... Hi Ron, Unfortunately still no luck. Scott. Ron de Bruin wrote: Remove this line On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message oups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Oh, and I forgot to mention (not that it's a big thing). Rather than a new workbook it should be a "pre-defined" sheet on a predefined workbook. That way I can have other sheets in the same workbook with pivot tables etc to extract whatever data I require. Thanks again, Scott. On Aug 27, 11:06 pm, scott wrote: Hi Ron, The indiv. files should be below one another. The example you posted seems like it would do the trick if it pastes them one below the other. Thanks for replying so fast, Scott. On Aug 27, 10:24 pm, "Ron de Bruin" wrote: Hi Scott Below each other or next to each other ? We can change this one to copy in the same sheethttp://www.rondebruin.nl/txtcsv.htm -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi all, I have many identical format comma delimited text files in a folder, named as follows: B1010607.txt. The user needs to be prompted which files to import, and then the macro should import them one after another into the same worksheet. I'm struggling with it. I have a macro to import all text files in a folder, but the problem is that the first 2 digits are either B1 or B2 - and must be distinct in the worksheet. Maybe if the B1 files went to one worksheet, the B2 ones went to another? Another idea - maybe if upon importing, the B1 or B2 could somehow be obtained and pasted in as the contents of the first column? Each sheet contains many rows of identical format data. Any ideas anyone? I'm REALLY struggling but it's really really important. Thanks in advance for any responses. Scott. |
Importing many text files into one excel worksheet - how to?
Hi Ron,
No errors - but nothing gets imported, either (it goes through the file import process ok, and then pauses - as if it's importing - but then just a blank sheet). If I go back to the original code posted by yourself (before the mod for the date column) it works ok, however. Thanks for bearing with me. Scott. On Aug 28, 4:33 pm, "Ron de Bruin" wrote: No errors ? -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Hi Ron, Unfortunately still no luck. Scott. Ron de Bruin wrote: Remove this line On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607..txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat ... read more » |
Importing many text files into one excel worksheet - how to?
Strange
Can you send me one of the txt files private so I can test it -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in message ups.com... Hi Ron, No errors - but nothing gets imported, either (it goes through the file import process ok, and then pauses - as if it's importing - but then just a blank sheet). If I go back to the original code posted by yourself (before the mod for the date column) it works ok, however. Thanks for bearing with me. Scott. On Aug 28, 4:33 pm, "Ron de Bruin" wrote: No errors ? -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Hi Ron, Unfortunately still no luck. Scott. Ron de Bruin wrote: Remove this line On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat ... read more » |
Importing many text files into one excel worksheet - how to?
Ah, yes it DOES work! The problem was that I had headings already in
for the columns (which I need, incidentally). Other than that, all is good - but I now have a problem with it stripping the leading zero from the date... But you're doing great stuff here. Thanks for this! Scott. (oh, and if someone sees a duplicate comment by me on another post, it's because I just replied to this post in the wrong window. D'oh!) On Aug 28, 5:09 pm, "Ron de Bruin" wrote: Strange Can you send me one of the txt files private so I can test it -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, No errors - but nothing gets imported, either (it goes through the file import process ok, and then pauses - as if it's importing - but then just a blank sheet). If I go back to the original code posted by yourself (before the mod for the date column) it works ok, however. Thanks for bearing with me. Scott. On Aug 28, 4:33 pm, "Ron de Bruin" wrote: No errors ? -- Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Hi Ron, Unfortunately still no luck. Scott. Ron de Bruin wrote: Remove this line On Error GoTo CleanUp And debug -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in ooglegroups.com... Ron, For some reason nothing. No error, but nothing is imported either. Scott. Ron de Bruin wrote: Tru this sub then Sub Get_TXT_Files_Test() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 2)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False 'Set the format for each column if you want (Default = General) 'For example Array(1, 9, 1) to skip the second column .TextFileColumnDataTypes = Array(1, 9, 1) 'xlGeneralFormat General 1 'xlTextFormat Text 2 'xlMDYFormat Month-Day-Year 3 'xlDMYFormat Day-Month-Year 4 'xlYMDFormat Year-Month-Day 5 'xlMYDFormat Month-Year-Day 6 'xlDYMFormat Day-Year-Month 7 'xlYDMFormat Year-Day-Month 8 'xlSkipColumn Skip 9 ' Get the data from the txt file .Refresh BackgroundQuery:=False End With Cells(I + 1, 1).Resize(LastRow(ActiveSheet) - I, 1).Value = _ Mid(TxtFileNames(Fnum), InStrRev(TxtFileNames(Fnum), "\", , 1) + 3, 6) Next Fnum CleanUp: For Each QTable In ActiveSheet.QueryTables QTable.Delete Next ChDirNet SaveDriveDir With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, Yes, there are always the 2 characters. They vary from either B1 or B2, but always follow the same format. Thanks in advance, Scott. Ron de Bruin wrote: Hi Scott B1020607.txt Are there always two characters (B1 in this file name) before the date -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "scott" wrote in oglegroups.com... Hi Ron, This works excellent, thankyou. One thing I didn't realise before though...The date isn't actually in the text file anywhere (which is useless). Is there a way we can extract the date from the name of the text file (i.e. B1020607.txt) and insert this into column 1 in the relevant places? Sorry if this is too much work - I'm pulling my hair out. Thanks in advance, Scott. (Note: I'll post this as a seperate in the same group as it kind of goes off on a tangent from this point). Ron de Bruin wrote: Hi Scott Test this one Copy all the code in a normal module of your workbook It will copy the data in the activesheet For all files in a folder check out also this page http://www.rondebruin.nl/csv.htm Private Declare Function SetCurrentDirectoryA Lib _ "kernel32" (ByVal lpPathName As String) As Long Public Function ChDirNet(szPath As String) As Boolean 'based on Rob Bovey's code Dim lReturn As Long lReturn = SetCurrentDirectoryA(szPath) ChDirNet = CBool(lReturn < 0) End Function Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub Get_TXT_Files() 'For Excel 2000 and higher Dim Fnum As Long Dim TxtFileNames As Variant Dim QTable As QueryTable Dim SaveDriveDir As String Dim ExistFolder As Boolean Dim I As Long 'Save the current dir SaveDriveDir = CurDir 'You can change the start folder if you want for 'GetOpenFilename,you can use a network or local folder. 'For example ChDirNet("C:\Users\Ron\test") 'It now use Excel's Default File Path ExistFolder = ChDirNet(Application.DefaultFilePath) If ExistFolder = False Then MsgBox "Error changing folder" Exit Sub End If TxtFileNames = Application.GetOpenFilename _ (filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True) If IsArray(TxtFileNames) Then On Error GoTo CleanUp With Application .ScreenUpdating = False .EnableEvents = False End With 'Loop through the array with txt files For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames) I = LastRow(ActiveSheet) With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & TxtFileNames(Fnum), Destination:=Cells(I + 1, 1)) .TextFilePlatform = xlWindows .TextFileStartRow = 1 'This example use xlDelimited 'See a example for xlFixedWidth below the macro .TextFileParseType = xlDelimited 'Set your Delimiter to true .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True ... read more » |
All times are GMT +1. The time now is 01:52 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com