browsing and selecting file

datacontrol

Registered User.
Local time
Today, 16:39
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
 
Here's a function which I have used countless times to perform this task; I believe that I got it off of this site, but unfortunately can't give credit to whomever originally posted as I really don't know:
Code:
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Function LaunchCD(strForm As Form) As String
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = strForm.Hwnd
    sFilter = "Excel Files (*.xls)" & Chr(0) & "*.xls" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\MyDocuments"
    OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
        If lReturn = 0 Then
            MsgBox "A file was not selected!", vbInformation, _
              "Select a file using the Common Dialog DLL"
         Else
            LaunchCD = Trim(OpenFile.lpstrFile)
         End If
End Function

You could then call this function in a form-level module and capture the filepath in a text box by:
Code:
My_Textbox=LaunchCD(Me)

*edit* for your needs, you will need to change my line of
Code:
sFilter = "Excel Files (*.xls)" & Chr(0) & "*.xls" & Chr(0)
so that it looks for .CSV files
 
Last edited:
thanks

I have already been making use of that code you posted and I have been toying with it to make it work for what I need. I can't figure out how to use it to simply browse for a file name, then save it in a string so that I can use the string as a file path in this first piece of 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

Before the previous code, I will need the following code or similar in order to have the user select the path. One thing I can not figure out is how to use the "open" button on the open file dialog box to store the filename and path as a string.

________________________________________________
Private Sub Command148_Click()
Dim strFilter As String
Dim strSaveFileName As String
Dim ConvertCSVtoXL As String

strFilter = ahtAddFilterItem(strFilter, "Comma Delimeted (*.csv)", "*.csv")
strSaveFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
Filter:=strFilter, _
flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

ConvertCSVtoXL = strSaveFileName
End Sub
 
Last edited:
Why can't you just say

strMyFile=LaunchCD(Me)

to store the filepath and then use that variable whenever you need it?
 
I have the following code below, but there are 2 issues.

1) for some reason, you have to click open twice for the dialog box to close.

2) The program tries to overwrite *csv ant the end of execution instead of renaming it to *.xls



Private Sub Command148_Click()
Dim strFilter As String
Dim strSaveFileName As String
Dim ConvertCSVtoXL As String
Dim appExcel As Excel.Application

strFilter = ahtAddFilterItem(strFilter, "Comma Delimeted (*.csv)", "*.csv")
strSaveFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
Filter:=strFilter, _
flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

strCSVPath = LaunchCD(Me)

'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
 
I have been toying with this, but no luck as of yet. That code I posted has many problems when executed.
 

Users who are viewing this thread

Back
Top Bottom