datacontrol
Registered User.
- Local time
- Today, 22:17
- Joined
- Jul 16, 2003
- Messages
- 142
I have code set up that takes a *.csv file and converts it to .xls among other things. The name of the *.csv file will change, and I would like the user to be able to browse for the file, then have the file name and path saved to a string which in turn will be identified when this command is executed. I am familiar with the code for the save as / open dialog box, but I am not certain if it can be implemented here. Below is my current code:
Public Sub ConvertCSVtoXL(strCSVPath As String)
Dim appExcel As Excel.Application
'Switch to Microsoft Excel so it won't go away when you finish.
On Error Resume Next
AppActivate "Microsoft Excel"
'If Excel isn't running, start and activate it
If Err Then
Shell "c:\Program Files\Microsoft Office\Office\" _
& "Excel /Automation", vbHide
AppActivate "Microsoft Excel"
End If
On Error GoTo 0
'Get an Application object so you can automate Excel.
Set appExcel = GetObject(, "Excel.Application")
With appExcel
.Workbooks.Open FileName:=strCSVPath
.Cells.EntireColumn.AutoFit
.Columns("A:A").NumberFormat = "0"
Dim i As Byte
Dim i2 As Integer
Dim aYear As Integer
Dim aMonth As Byte
Dim aDay As Byte
For i = 4 To 5
For i2 = 3 To .Cells(3, i).End(xlDown).Row
aYear = Left(.Cells(i2, i), 4)
aMonth = Mid(.Cells(i2, i), 5, 2)
aDay = Right(.Cells(i2, i), 2)
.Cells(i2, i) = DateSerial(aYear, aMonth, aDay)
Next i2
Next i
.ActiveWorkbook.SaveAs FileName:=Left(strCSVPath, Len(strCSVPath) - 3) & "xls" _
, FileFormat:=xlNormal
End With
appExcel.Quit
Set appExcel = Nothing
MsgBox "File '" & strCSVPath & "' has been converted to excel under the same " & _
"filename with an XLS extension"
End Sub
Private Sub Command148_Click()
ConvertCSVtoXL = ""
End Sub
Public Sub ConvertCSVtoXL(strCSVPath As String)
Dim appExcel As Excel.Application
'Switch to Microsoft Excel so it won't go away when you finish.
On Error Resume Next
AppActivate "Microsoft Excel"
'If Excel isn't running, start and activate it
If Err Then
Shell "c:\Program Files\Microsoft Office\Office\" _
& "Excel /Automation", vbHide
AppActivate "Microsoft Excel"
End If
On Error GoTo 0
'Get an Application object so you can automate Excel.
Set appExcel = GetObject(, "Excel.Application")
With appExcel
.Workbooks.Open FileName:=strCSVPath
.Cells.EntireColumn.AutoFit
.Columns("A:A").NumberFormat = "0"
Dim i As Byte
Dim i2 As Integer
Dim aYear As Integer
Dim aMonth As Byte
Dim aDay As Byte
For i = 4 To 5
For i2 = 3 To .Cells(3, i).End(xlDown).Row
aYear = Left(.Cells(i2, i), 4)
aMonth = Mid(.Cells(i2, i), 5, 2)
aDay = Right(.Cells(i2, i), 2)
.Cells(i2, i) = DateSerial(aYear, aMonth, aDay)
Next i2
Next i
.ActiveWorkbook.SaveAs FileName:=Left(strCSVPath, Len(strCSVPath) - 3) & "xls" _
, FileFormat:=xlNormal
End With
appExcel.Quit
Set appExcel = Nothing
MsgBox "File '" & strCSVPath & "' has been converted to excel under the same " & _
"filename with an XLS extension"
End Sub
Private Sub Command148_Click()
ConvertCSVtoXL = ""
End Sub