|
Problem with an amended macro. Please help!
I have tried to amend this macro to use myself but its not working. can
anyone see why this would not be working? i am trying to open a folder 'folderName' and loop through, converting all csv files to xls files. thanks, dave Sub CSVToXls() Dim folderName As String folderName = GetFolderName("Select a folder") If folderName = "" Then MsgBox "You Didn't Select A Folder." Else End If Application.DisplayAlerts = False myFile = ActiveWorkbook.Name myPath = foldername WorkFile = Dir(myPath & "*.CSV") Do While WorkFile < "" Application.StatusBar = "Now working on " & WorkFile Workbooks.Open Filename:=myPath & WorkFile ActiveWorkbook.SaveAs Filename:=myPath & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlNormal ActiveWorkbook.Close Windows(myFile).Activate WorkFile = Dir() Loop Application.StatusBar = False End Sub Note: I have the following code also to allow for the GetFolderName Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim x As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return x = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function |
Problem with an amended macro. Please help!
I see a couple of possible problems.
For this: WorkFile = Dir(myPath & "*.CSV") Make sure that myPath has a "\" at the end Also change this Workbooks.Open Filename:=myPath & WorkFile to this Set oWB = Workbooks.Open Filename:=myPath & WorkFile And do all your action on oWB -- HTH, Barb Reinhardt "Dave" wrote: I have tried to amend this macro to use myself but its not working. can anyone see why this would not be working? i am trying to open a folder 'folderName' and loop through, converting all csv files to xls files. thanks, dave Sub CSVToXls() Dim folderName As String folderName = GetFolderName("Select a folder") If folderName = "" Then MsgBox "You Didn't Select A Folder." Else End If Application.DisplayAlerts = False myFile = ActiveWorkbook.Name myPath = foldername WorkFile = Dir(myPath & "*.CSV") Do While WorkFile < "" Application.StatusBar = "Now working on " & WorkFile Workbooks.Open Filename:=myPath & WorkFile ActiveWorkbook.SaveAs Filename:=myPath & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlNormal ActiveWorkbook.Close Windows(myFile).Activate WorkFile = Dir() Loop Application.StatusBar = False End Sub Note: I have the following code also to allow for the GetFolderName Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim x As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return x = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function |
Problem with an amended macro. Please help!
Where do I put the \ on myPath?
Thanks Dave "Barb Reinhardt" wrote: I see a couple of possible problems. For this: WorkFile = Dir(myPath & "*.CSV") Make sure that myPath has a "\" at the end Also change this Workbooks.Open Filename:=myPath & WorkFile to this Set oWB = Workbooks.Open Filename:=myPath & WorkFile And do all your action on oWB -- HTH, Barb Reinhardt "Dave" wrote: I have tried to amend this macro to use myself but its not working. can anyone see why this would not be working? i am trying to open a folder 'folderName' and loop through, converting all csv files to xls files. thanks, dave Sub CSVToXls() Dim folderName As String folderName = GetFolderName("Select a folder") If folderName = "" Then MsgBox "You Didn't Select A Folder." Else End If Application.DisplayAlerts = False myFile = ActiveWorkbook.Name myPath = foldername WorkFile = Dir(myPath & "*.CSV") Do While WorkFile < "" Application.StatusBar = "Now working on " & WorkFile Workbooks.Open Filename:=myPath & WorkFile ActiveWorkbook.SaveAs Filename:=myPath & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlNormal ActiveWorkbook.Close Windows(myFile).Activate WorkFile = Dir() Loop Application.StatusBar = False End Sub Note: I have the following code also to allow for the GetFolderName Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim x As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return x = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function |
Problem with an amended macro. Please help!
I'd also put a oWB.close before the loop or else you could have a whole lot
of docs open. -- HTH, Barb Reinhardt "Dave" wrote: I have tried to amend this macro to use myself but its not working. can anyone see why this would not be working? i am trying to open a folder 'folderName' and loop through, converting all csv files to xls files. thanks, dave Sub CSVToXls() Dim folderName As String folderName = GetFolderName("Select a folder") If folderName = "" Then MsgBox "You Didn't Select A Folder." Else End If Application.DisplayAlerts = False myFile = ActiveWorkbook.Name myPath = foldername WorkFile = Dir(myPath & "*.CSV") Do While WorkFile < "" Application.StatusBar = "Now working on " & WorkFile Workbooks.Open Filename:=myPath & WorkFile ActiveWorkbook.SaveAs Filename:=myPath & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlNormal ActiveWorkbook.Close Windows(myFile).Activate WorkFile = Dir() Loop Application.StatusBar = False End Sub Note: I have the following code also to allow for the GetFolderName Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim x As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return x = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function |
Problem with an amended macro. Please help!
Make this modification
myPath = foldername '<~~~you already have this if not right(mypath,1) = "\" then mypath = mypath & "\" end if -- HTH, Barb Reinhardt "Dave" wrote: Where do I put the \ on myPath? Thanks Dave "Barb Reinhardt" wrote: I see a couple of possible problems. For this: WorkFile = Dir(myPath & "*.CSV") Make sure that myPath has a "\" at the end Also change this Workbooks.Open Filename:=myPath & WorkFile to this Set oWB = Workbooks.Open Filename:=myPath & WorkFile And do all your action on oWB -- HTH, Barb Reinhardt "Dave" wrote: I have tried to amend this macro to use myself but its not working. can anyone see why this would not be working? i am trying to open a folder 'folderName' and loop through, converting all csv files to xls files. thanks, dave Sub CSVToXls() Dim folderName As String folderName = GetFolderName("Select a folder") If folderName = "" Then MsgBox "You Didn't Select A Folder." Else End If Application.DisplayAlerts = False myFile = ActiveWorkbook.Name myPath = foldername WorkFile = Dir(myPath & "*.CSV") Do While WorkFile < "" Application.StatusBar = "Now working on " & WorkFile Workbooks.Open Filename:=myPath & WorkFile ActiveWorkbook.SaveAs Filename:=myPath & _ Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlNormal ActiveWorkbook.Close Windows(myFile).Activate WorkFile = Dir() Loop Application.StatusBar = False End Sub Note: I have the following code also to allow for the GetFolderName Private Type BROWSEINFO ' used by the function GetFolderName hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Function GetFolderName(Msg As String) As String ' returns the name of the folder selected by the user Dim bInfo As BROWSEINFO, path As String, r As Long Dim x As Long, pos As Integer bInfo.pidlRoot = 0& ' Root folder = Desktop If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." ' the dialog title Else bInfo.lpszTitle = Msg ' the dialog title End If bInfo.ulFlags = &H1 ' Type of directory to return x = SHBrowseForFolder(bInfo) ' display the dialog ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetFolderName = Left(path, pos - 1) Else GetFolderName = "" End If End Function |
| All times are GMT +1. The time now is 07:16 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com