Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi All,
I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#3
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Ron,
Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#4
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Dan
I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#5
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Thanks Ron, that sounds excellent. I look forward to it.
Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#6
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
OK
Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#7
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Oops
Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _ Space:=True, Other:=False 'Save text file as a XLS file Set Wb = ActiveWorkbook Application.DisplayAlerts = False Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Wb.Close savechanges:=False MsgBox "You find the XLS file he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub |
#8
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Ron,
;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, |
#9
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Dan
Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, |
#10
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Ron,
You have mail. "Ron de Bruin" wrote: Hi Dan Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") |
#11
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Dan
I reply this evening, I see it in my Inbox -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, You have mail. "Ron de Bruin" wrote: Hi Dan Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") |
#12
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Hi Dan
I have look at it and the solution is very simple You copy my macro and Chip's macro in a sheet module and not in a normal module. In the VBA editor use InsertModule and move the code from the sheet module in the normal module. See also http://www.cpearson.com/excel/codemods.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Hi Dan I reply this evening, I see it in my Inbox -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, You have mail. "Ron de Bruin" wrote: Hi Dan Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") |
#13
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Thank you very much Ron, it works perfectly. :)
If I can ever return the favour please drop me a line. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I have look at it and the solution is very simple You copy my macro and Chip's macro in a sheet module and not in a normal module. In the VBA editor use InsertModule and move the code from the sheet module in the normal module. See also http://www.cpearson.com/excel/codemods.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Hi Dan I reply this evening, I see it in my Inbox -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, You have mail. "Ron de Bruin" wrote: Hi Dan Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long |
#14
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Thanks for the feedback Dan
You are welcome -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thank you very much Ron, it works perfectly. :) If I can ever return the favour please drop me a line. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I have look at it and the solution is very simple You copy my macro and Chip's macro in a sheet module and not in a normal module. In the VBA editor use InsertModule and move the code from the sheet module in the normal module. See also http://www.cpearson.com/excel/codemods.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Hi Dan I reply this evening, I see it in my Inbox -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, You have mail. "Ron de Bruin" wrote: Hi Dan Can you send me a few txt files private then I look at it for you tomorrow -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, ;) That explains why I was struggling to get it to call the 2nd macro! it's looking good though. It's almost there. It finds the txt files fine and it will happily create multiple individual worksheets for each txt file, named correctly. The problem is there is no data in any of them. Only the starting blank worksheet, 'sheet 1', contains imported data, but correctly formatted though. looks like the data from the last txt file (or first if the routine starts from bottom up) Any idea why the data is not appearing. I am opening Xcel, new book. Hitting Alt F11, copying in the macro, Alt Q out to Xcel again, Alt F8 followed by run. Cheers, Dan "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long |
#15
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Thanks for the good example you have provided Ron!
I get almost what I want, but there is one problem remaining it seems. I have changed the code so that it puts the content of the text-files in separate columns that are offset one by one. Works perfect! But some of the values get corrupt. The content of the text files are values describing a cyclical curve. They typically start at 0,000 and decrease: 0,000 0,000 0,000 0,000 -0,100 -0,100 -0,100 -0,200 -0,200 -0,300 -0,300 -0,400 -0,500 -0,600 -0,700 -0,800 -0,900 -1,000 -1,100 -1,100 -1,200 -1,200 -1,300 The problem is that after importing this text, when the value is less than -1, the results get 1000 times too big. I am guessing that Excel interprets the coma-sign as a divider of thousands? 0,000 0,000 -0,100 -0,100 -0,100 -0,200 -0,200 -0,300 -0,300 -0,400 -0,500 -0,600 -0,700 -0,800 -0,900 -1000,000 -1100,000 -1100,000 -1200,000 -1200,000 Can anyone help me address this problem so that the values get correct? I am going to make a curve of them, so getting the imported text to convert to numbers is also a good thing (or maybe it is the same problem?) I have attached the code below. Thanks, Peter Sub myImportdata() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), vbCrLf, Fnum Next Fnum End If MsgBox "Done!" CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String, Fnum As Long) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: Range("C10").Offset(0, Fnum).Select SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -------- Peter "Ron de Bruin" wrote: Oops Sorry I forgot to add the path in this line Use this ' Call Chip Pearson's macro ImportTextFile MyPath & MyFiles(Fnum), " " -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... OK Test this one Dan Change the folder to your folder MyPath = "C:\Users\Ron\test" Sub Example2() Dim MyPath As String Dim FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mysheet As Worksheet Dim basebook As Workbook 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp Application.ScreenUpdating = False Set basebook = ThisWorkbook 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mysheet = Worksheets.Add mysheet.Name = MyFiles(Fnum) ' Call Chip Pearson's macro ImportTextFile MyFiles(Fnum), " " Next Fnum End If CleanUp: Application.ScreenUpdating = True End Sub Public Sub ImportTextFile(FName As String, Sep As String) 'http://www.cpearson.com/excel/imptext.htm Dim RowNdx As Long Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Application.ScreenUpdating = False 'On Error GoTo EndMacro: SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row Open FName For Input Access Read As #1 While Not EOF(1) Line Input #1, WholeLine If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = TempVal Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Wend RowNdx = RowNdx + 1 Wend EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Thanks Ron, that sounds excellent. I look forward to it. Cheers, Dan "Ron de Bruin" wrote: Hi Dan I will post a example today that loop through all files in the folder and insert a sheet each time and import the data. -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" wrote in message ... Hi Ron, Thanks for the link. That looks like I can use it to insert the txt files where I want them. Do I need to open a new worksheet manually then start the macro to specify the txt file to import or is it possible to automate the process so that one macro creates a new worksheet, then calls up the second to import the txt file, then opens up a new worksheet and again prompts for a file name to import? Cheers, Dan "Ron de Bruin" wrote: Hi Dr Dan No if you want to have each txt file in a seperate worksheet then this is not working You want every txt file in a seperate sheet in your workbook. Am I correct ? See also this page http://www.cpearson.com/excel/imptext.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dr Dan" <Dr wrote in message ... Hi All, I'm trying desperately to find a way to automatically import many space delimited .txt files (all contained in a single folder) so that each .txt file is put into its own worksheet, named according to the original .txt filename. Is this possible? I found an excellent macro written by Ron de Bruin which I modified as suggested in his post to work for importing many txt files into a single worksheet. I have copied this below. From what I can work out (I know nothing about Visual Basic) it operates by combining all the txt files into a single txt file and then importing that into excel. I guess that approach is not adaptable to what I need. Ideally, I need a macro that will allow me to browse to the correct folder, then individually import each txt file into a worksheet then move to the next txt file and create a new worksheet for it to go in to and then keep going like this until all files have been converted. As I mentioned, I don't understand the codes but can install them into Excel OK with a little help as Ron de Bruin included in his post. Cheers for any assistance, Dan Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, _ lpExitCode As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const STILL_ACTIVE = &H103 Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState) Dim hProg As Long Dim hProcess As Long, ExitCode As Long 'fill in the missing parameter and execute the program If IsMissing(WindowState) Then WindowState = 1 hProg = Shell(PathName, WindowState) 'hProg is a "process ID under Win32. To get the process handle: hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg) Do 'populate Exitcode variable GetExitCodeProcess hProcess, ExitCode DoEvents Loop While ExitCode = STILL_ACTIVE End Sub Sub Merge_txt_Files() Dim BatFileName As String Dim TXTFileName As String Dim XLSFileName As String Dim DefPath As String Dim Wb As Workbook Dim oApp As Object Dim oFolder Dim foldername 'Create two temporary file names BatFileName = Environ("Temp") & "\CollecttxtData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat" TXTFileName = Environ("Temp") & "\Alltxt" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt" ' Create path to xls file DefPath = Application.DefaultFilePath If Right(DefPath, 1) < "\" Then DefPath = DefPath & "\" End If XLSFileName = DefPath & "Mastertxt " & Format(Now, "dd-mm-yy h-mm-ss") & ".xls" 'Browse to the folder with txt files Set oApp = CreateObject("Shell.Application") Set oFolder = oApp.BrowseForFolder(0, "Select folder with txt files", 512) If Not oFolder Is Nothing Then foldername = oFolder.Self.Path If Right(foldername, 1) < "\" Then foldername = foldername & "\" End If 'Create the bat file Open BatFileName For Output As #1 Print #1, "Copy " & Chr(34) & foldername & "*.txt" & Chr(34) & " " & TXTFileName Close #1 'Run the Bat file to collect all data from the txt files into a TXT file ShellAndWait BatFileName, 0 If Dir(TXTFileName) = "" Then MsgBox "There are no txt files in this folder" Kill BatFileName Exit Sub End If 'Open the TXT file in Excel Application.ScreenUpdating = False Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
opening multiple files into one workbook, but multiple worksheets.... | Excel Discussion (Misc queries) | |||
Open multiple files into multiple worksheets of the same workbook | Excel Discussion (Misc queries) | |||
Multiple Sheets (Need to create 500 individual sheets in one workbook, pulling DATA | Excel Worksheet Functions | |||
How do i auto create multiple files from 1 with multiple sheets | Excel Worksheet Functions | |||
Exporting multiple sheets to multiple htm files? | Excel Discussion (Misc queries) |