D
Dave
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
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