loupus
asked on
Use "browse" with transferspreadsheet macro?
I created a database that uses a transferspreadsheet macro to import data. The spreadsheets that will be imported are to be archived, however, and I would like to be able to allow the user to browse and find the spreadsheet to be imported. Currently the macro finds a static location on a network drive.
I want to do this to minimize confusion and incorrect file naming when archiving.
Thank you
I want to do this to minimize confusion and incorrect file naming when archiving.
Thank you
loupus: Welcome to EE.
You're looking for the common dialog box which allows you to 'browse' through drives, directories, files. Right?
Here is the API code that you can use for opening/saving files:
Jim
Type gtypTagOPENFILENAME
lngLStructSize As Long
lngHWndOwner As Long
lngHInstance As Long
strFilter As String
strCustomFilter As String
lngNMaxCustFilter As Long
lngNFilterIndex As Long
strFile As String
lngNMaxFile As Long
strFileTitle As String
lngNMaxFileTitle As Long
strInitialDir As String
strTitle As String
lngFlags As Long
intNFileOffset As Integer
intNFileExtension As Integer
strDefExt As String
lngLCustData As Long
lngLpfnHook As Long
strLpTemplateName As String
End Type
Declare Function adh_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As gtypTagOPENFILENAME) As Boolean
Declare Function adh_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As gtypTagOPENFILENAME) As Boolean
Public Const gAdhOFN_HIDEREADONLY As Long = &H4
Public Const gAdhOFN_NOCHANGEDIR As Long = &H8
Function adhCommonFileOpenSave( _
Optional ByRef varFlags As Variant, _
Optional ByVal varInitialDir As Variant, _
Optional ByVal varFilter As Variant, _
Optional ByVal varFilterIndex As Variant, _
Optional ByVal varDefaultExt As Variant, _
Optional ByVal varFileName As Variant, _
Optional ByVal varDialogTitle As Variant, _
Optional ByVal varOpenFile As Variant) As Variant
' Comments :
' Parameters : varFlags
' varInitialDir
' varFilter
' varFilterIndex
' varDefaultExt
' varFileName
' varDialogTitle
' varOpenFile -
' Returns : Variant -
' Created :
' Modified :
'
' --------------------------
' This is the entry point you'll use to the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the adhOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
160 On Error GoTo PROC_ERR
Dim ofn As gtypTagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
170 If IsMissing(varInitialDir) Then varInitialDir = vbNullString
180 If IsMissing(varFilter) Then varFilter = vbNullString
190 If IsMissing(varFilterIndex) Then varFilterIndex = 1
200 If IsMissing(varFlags) Then varFlags = 0&
210 If IsMissing(varDefaultExt) Then varDefaultExt = vbNullString
220 If IsMissing(varFileName) Then varFileName = vbNullString
230 If IsMissing(varDialogTitle) Then varDialogTitle = vbNullString
240 If IsMissing(varOpenFile) Then varOpenFile = True
' Allocate string space for the returned strings.
250 strFileName = Left$(varFileName & String$(256, 0), 256)
260 strFileTitle = String$(256, 0)
' Set up the data structure before you use the function
270 With ofn
280 .lngLStructSize = Len(ofn)
290 .lngHWndOwner = Application.hWndAccessApp
300 .strFilter = varFilter
310 .lngNFilterIndex = varFilterIndex
320 .strFile = strFileName
330 .lngNMaxFile = Len(strFileName)
340 .strFileTitle = strFileTitle
350 .lngNMaxFileTitle = Len(strFileTitle)
360 .strTitle = varDialogTitle
370 .lngFlags = varFlags
380 .strDefExt = varDefaultExt
390 .strInitialDir = CurDir
' Didn't think most people would want to deal with
' these options.
400 .lngHInstance = 0
410 .strCustomFilter = vbNullString
420 .lngNMaxCustFilter = 0
430 .lngLpfnHook = 0
440 End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
450 If varOpenFile Then
460 fResult = adh_apiGetOpenFileName(ofn
470 Else
480 fResult = adh_apiGetSaveFileName(ofn
490 End If
' The function filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
500 If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
510 If IsMissing(varFlags) Then
520 Else
530 varFlags = ofn.lngFlags
540 End If
550 adhCommonFileOpenSave = adhTrimNull(ofn.strFile)
560 Else
570 adhCommonFileOpenSave = Null
580 End If
590 Exit Function
PROC_ERR:
610 Resume Next
End Function
Function adhTrimNull(ByVal strItem As String) As String
' Comments :
' Parameters : strItem -
' Returns : String -
' Created :
' Modified :
'
' --------------------------
' Trims the Null from a string returned by an API
'
' In:
' strItem: string that contains null terminator
' Out:
' Return value: same string without null terminator
620 On Error GoTo PROC_ERR
Dim intPos As Integer
630 intPos = InStr(strItem, vbNullChar)
640 If intPos > 0 Then
650 adhTrimNull = Left$(strItem, intPos - 1)
660 Else
670 adhTrimNull = strItem
680 End If
690 Exit Function
PROC_ERR:
710 Resume
You're looking for the common dialog box which allows you to 'browse' through drives, directories, files. Right?
Here is the API code that you can use for opening/saving files:
Jim
Type gtypTagOPENFILENAME
lngLStructSize As Long
lngHWndOwner As Long
lngHInstance As Long
strFilter As String
strCustomFilter As String
lngNMaxCustFilter As Long
lngNFilterIndex As Long
strFile As String
lngNMaxFile As Long
strFileTitle As String
lngNMaxFileTitle As Long
strInitialDir As String
strTitle As String
lngFlags As Long
intNFileOffset As Integer
intNFileExtension As Integer
strDefExt As String
lngLCustData As Long
lngLpfnHook As Long
strLpTemplateName As String
End Type
Declare Function adh_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As gtypTagOPENFILENAME) As Boolean
Declare Function adh_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As gtypTagOPENFILENAME) As Boolean
Public Const gAdhOFN_HIDEREADONLY As Long = &H4
Public Const gAdhOFN_NOCHANGEDIR As Long = &H8
Function adhCommonFileOpenSave( _
Optional ByRef varFlags As Variant, _
Optional ByVal varInitialDir As Variant, _
Optional ByVal varFilter As Variant, _
Optional ByVal varFilterIndex As Variant, _
Optional ByVal varDefaultExt As Variant, _
Optional ByVal varFileName As Variant, _
Optional ByVal varDialogTitle As Variant, _
Optional ByVal varOpenFile As Variant) As Variant
' Comments :
' Parameters : varFlags
' varInitialDir
' varFilter
' varFilterIndex
' varDefaultExt
' varFileName
' varDialogTitle
' varOpenFile -
' Returns : Variant -
' Created :
' Modified :
'
' --------------------------
' This is the entry point you'll use to the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the adhOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
160 On Error GoTo PROC_ERR
Dim ofn As gtypTagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
170 If IsMissing(varInitialDir) Then varInitialDir = vbNullString
180 If IsMissing(varFilter) Then varFilter = vbNullString
190 If IsMissing(varFilterIndex) Then varFilterIndex = 1
200 If IsMissing(varFlags) Then varFlags = 0&
210 If IsMissing(varDefaultExt) Then varDefaultExt = vbNullString
220 If IsMissing(varFileName) Then varFileName = vbNullString
230 If IsMissing(varDialogTitle) Then varDialogTitle = vbNullString
240 If IsMissing(varOpenFile) Then varOpenFile = True
' Allocate string space for the returned strings.
250 strFileName = Left$(varFileName & String$(256, 0), 256)
260 strFileTitle = String$(256, 0)
' Set up the data structure before you use the function
270 With ofn
280 .lngLStructSize = Len(ofn)
290 .lngHWndOwner = Application.hWndAccessApp
300 .strFilter = varFilter
310 .lngNFilterIndex = varFilterIndex
320 .strFile = strFileName
330 .lngNMaxFile = Len(strFileName)
340 .strFileTitle = strFileTitle
350 .lngNMaxFileTitle = Len(strFileTitle)
360 .strTitle = varDialogTitle
370 .lngFlags = varFlags
380 .strDefExt = varDefaultExt
390 .strInitialDir = CurDir
' Didn't think most people would want to deal with
' these options.
400 .lngHInstance = 0
410 .strCustomFilter = vbNullString
420 .lngNMaxCustFilter = 0
430 .lngLpfnHook = 0
440 End With
' This will pass the desired data structure to the
' Windows API, which will in turn it uses to display
' the Open/Save As Dialog.
450 If varOpenFile Then
460 fResult = adh_apiGetOpenFileName(ofn
470 Else
480 fResult = adh_apiGetSaveFileName(ofn
490 End If
' The function filled in the strFileTitle member
' of the structure. You'll have to write special code
' to retrieve that if you're interested.
500 If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass in a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
510 If IsMissing(varFlags) Then
520 Else
530 varFlags = ofn.lngFlags
540 End If
550 adhCommonFileOpenSave = adhTrimNull(ofn.strFile)
560 Else
570 adhCommonFileOpenSave = Null
580 End If
590 Exit Function
PROC_ERR:
610 Resume Next
End Function
Function adhTrimNull(ByVal strItem As String) As String
' Comments :
' Parameters : strItem -
' Returns : String -
' Created :
' Modified :
'
' --------------------------
' Trims the Null from a string returned by an API
'
' In:
' strItem: string that contains null terminator
' Out:
' Return value: same string without null terminator
620 On Error GoTo PROC_ERR
Dim intPos As Integer
630 intPos = InStr(strItem, vbNullChar)
640 If intPos > 0 Then
650 adhTrimNull = Left$(strItem, intPos - 1)
660 Else
670 adhTrimNull = strItem
680 End If
690 Exit Function
PROC_ERR:
710 Resume
ASKER
I apologize, but I have very little VB experience and have never coded in Access.
I assume I use the API code with a Module, but I don't know how. I use the Access 97 Bible as my primary reference and it's all GUI related, no code.
I was able to select "adhCommonFileOpenSave" and run it (play button) within the Module Design screen, but I'm not sure how to compile it, etc.
Can you please tell me :
1.) How to utilize this code
2.) How to link the module to a command button/macro so the user can click the button, select the file and have the macro transfer the spreadsheet.
I hope I'm not wasting your time and that I'm permitted to use this site since I'm certainly no expert, just an intermediate access user/designer.
Thank you,
Sean Reed
I assume I use the API code with a Module, but I don't know how. I use the Access 97 Bible as my primary reference and it's all GUI related, no code.
I was able to select "adhCommonFileOpenSave" and run it (play button) within the Module Design screen, but I'm not sure how to compile it, etc.
Can you please tell me :
1.) How to utilize this code
2.) How to link the module to a command button/macro so the user can click the button, select the file and have the macro transfer the spreadsheet.
I hope I'm not wasting your time and that I'm permitted to use this site since I'm certainly no expert, just an intermediate access user/designer.
Thank you,
Sean Reed
Sean:
You're most welcome here. The site is open to people of all levels. The ones who know more, the 'experts', help each other and the ones who want to know more.
This is a big task to do right out of the box but most of the work is done for you. Ordinarily, I would encourage members to write their own code but this is not that level of code. API calls, as well as a few other internals of Windows, are quite difficult to learn and master. If I were you, I wouldn't even try. Just use the code if it works and be happy.
Highlight the code in my first comment. Press Ctrl C, which will copy the selected code to the ClipBoard.
Open Access and select your database. Go to the modules tab and click New. This will open up a new blank module. Put the cursor in the module and press Ctrl V, which will past the code from the ClipBoard to the module. Add this function as well. I didn't realize that you would need it.
Function adhAddFilterItem(strFilter
strDescription As String, Optional varItem As Variant) As String
' Tack a new parameter onto the file filter.
' That is, take the old value, add the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.
'
' In:
' strFilter: existing file filter
' strDescription: new filter description
' varItem: new filter
' Out:
' Return value: new file filter
100 On Error GoTo PROC_ERR
110 If IsMissing(varItem) Then varItem = "*.*"
120 adhAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
130 Exit Function
PROC_ERR:
150 Resume Next
End Function
Save the module and call it whatever you like.
In the form where you want to transfer the spreadsheet data, create a command button (I'm going to assume that your book will help you do that) and in the OnClick event in the button's properties, click the elipse ... at the right edge of the property line. This will open a sub inside the form's class module.
Since I don't know how your macro is written and since we can't pass arguements to a macro, I've included a VB replacement code line to replace what I think that you are doing with the macro. You will also have to change this code to put in the table name where this info is to be stored as well as the range of values to get from the spreadsheet. (I also am assuming that you are working with an Excel spreadsheet.)
Copy and paste this code to that sub:
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName as Variant
Dim strTableName as String
Dim strRange as String
strTableName = ' target table
strRange = ' spreadsheet range of values
' Let user find the spreadsheet file using common dialog
' Display Open File dialog using the adhCommonFileOpenSave
' function in the new basic module
strFilter = adhAddFilterItem(strFilter
lngFlags = gAdhOFN_HIDEREADONLY Or gAdhOFN_NOCHANGEDIR
varFileName = adhCommonFileOpenSave(varO
varFilter:=strFilter, _
varFlags:=lngFlags, _
varDialogTitle:="SpreadShe
If Len(varFileName) Then
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
End If
Good Luck,
Jim
You're most welcome here. The site is open to people of all levels. The ones who know more, the 'experts', help each other and the ones who want to know more.
This is a big task to do right out of the box but most of the work is done for you. Ordinarily, I would encourage members to write their own code but this is not that level of code. API calls, as well as a few other internals of Windows, are quite difficult to learn and master. If I were you, I wouldn't even try. Just use the code if it works and be happy.
Highlight the code in my first comment. Press Ctrl C, which will copy the selected code to the ClipBoard.
Open Access and select your database. Go to the modules tab and click New. This will open up a new blank module. Put the cursor in the module and press Ctrl V, which will past the code from the ClipBoard to the module. Add this function as well. I didn't realize that you would need it.
Function adhAddFilterItem(strFilter
strDescription As String, Optional varItem As Variant) As String
' Tack a new parameter onto the file filter.
' That is, take the old value, add the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.
'
' In:
' strFilter: existing file filter
' strDescription: new filter description
' varItem: new filter
' Out:
' Return value: new file filter
100 On Error GoTo PROC_ERR
110 If IsMissing(varItem) Then varItem = "*.*"
120 adhAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
130 Exit Function
PROC_ERR:
150 Resume Next
End Function
Save the module and call it whatever you like.
In the form where you want to transfer the spreadsheet data, create a command button (I'm going to assume that your book will help you do that) and in the OnClick event in the button's properties, click the elipse ... at the right edge of the property line. This will open a sub inside the form's class module.
Since I don't know how your macro is written and since we can't pass arguements to a macro, I've included a VB replacement code line to replace what I think that you are doing with the macro. You will also have to change this code to put in the table name where this info is to be stored as well as the range of values to get from the spreadsheet. (I also am assuming that you are working with an Excel spreadsheet.)
Copy and paste this code to that sub:
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName as Variant
Dim strTableName as String
Dim strRange as String
strTableName = ' target table
strRange = ' spreadsheet range of values
' Let user find the spreadsheet file using common dialog
' Display Open File dialog using the adhCommonFileOpenSave
' function in the new basic module
strFilter = adhAddFilterItem(strFilter
lngFlags = gAdhOFN_HIDEREADONLY Or gAdhOFN_NOCHANGEDIR
varFileName = adhCommonFileOpenSave(varO
varFilter:=strFilter, _
varFlags:=lngFlags, _
varDialogTitle:="SpreadShe
If Len(varFileName) Then
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
End If
Good Luck,
Jim
ASKER
Jim,
Okay, I think I'm/we're almost there!
I've created the module (named "Browse") with the entire code above and created a command button on the form (named "BrowseButton") and when I click the "BrowseButton" the open file window pops up, and I'm able to select the file I want.
However, when I click "Open" in the browse window, I get a run-time error '3170' and it states "couldn't find installable ISAM." If I select "Debug", it takes me to the command button's class module code and hightlights the following in yellow:
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
If I understand correctly, "installable ISAM" refers to a driver used for importing from other sources. Maybe that's not actually the case, since I've never had problems importing spreadsheets before.
I have specified the table to be imported to and the range I need imported as follows--I'll just include the entire code to see if it looks right to you. One thing I added was a ")" at the end of
varDialogTitle:="SpreadShe
Access presented a window that said it was expected. Here's the code:
Private Sub BrowseButton_Click()
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Dim strTableName As String
Dim strRange As String
strTableName = "Imported Data"
strRange = "a8:k10000"
' Let user find the spreadsheet file using common dialog
' Display Open File dialog using the adhCommonFileOpenSave
' function in the new basic module
strFilter = adhAddFilterItem(strFilter
lngFlags = gAdhOFN_HIDEREADONLY Or gAdhOFN_NOCHANGEDIR
varFileName = adhCommonFileOpenSave(varO
varFilter:=strFilter, _
varFlags:=lngFlags, _
varDialogTitle:="SpreadShe
If Len(varFileName) Then
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
End If
End Sub
Do you see anything wrong? I can't figure it out. This code doesn't need to reference the module by name does it ("Browse")?
Thanks for all your patient help,
Sean
Okay, I think I'm/we're almost there!
I've created the module (named "Browse") with the entire code above and created a command button on the form (named "BrowseButton") and when I click the "BrowseButton" the open file window pops up, and I'm able to select the file I want.
However, when I click "Open" in the browse window, I get a run-time error '3170' and it states "couldn't find installable ISAM." If I select "Debug", it takes me to the command button's class module code and hightlights the following in yellow:
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
If I understand correctly, "installable ISAM" refers to a driver used for importing from other sources. Maybe that's not actually the case, since I've never had problems importing spreadsheets before.
I have specified the table to be imported to and the range I need imported as follows--I'll just include the entire code to see if it looks right to you. One thing I added was a ")" at the end of
varDialogTitle:="SpreadShe
Access presented a window that said it was expected. Here's the code:
Private Sub BrowseButton_Click()
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Dim strTableName As String
Dim strRange As String
strTableName = "Imported Data"
strRange = "a8:k10000"
' Let user find the spreadsheet file using common dialog
' Display Open File dialog using the adhCommonFileOpenSave
' function in the new basic module
strFilter = adhAddFilterItem(strFilter
lngFlags = gAdhOFN_HIDEREADONLY Or gAdhOFN_NOCHANGEDIR
varFileName = adhCommonFileOpenSave(varO
varFilter:=strFilter, _
varFlags:=lngFlags, _
varDialogTitle:="SpreadShe
If Len(varFileName) Then
DoCmd.TransferSpreadsheet acImport, 3, strTableName, varFileName, True, strRange
End If
End Sub
Do you see anything wrong? I can't figure it out. This code doesn't need to reference the module by name does it ("Browse")?
Thanks for all your patient help,
Sean
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Jim,
The update you made to that line of code did the trick. No ISAM error this now.
I cannot thank you enough.
Thanks,
Sean
The update you made to that line of code did the trick. No ISAM error this now.
I cannot thank you enough.
Thanks,
Sean
ASKER
The line of code you fixed did the trick.
Thanks very much for taking the time to help me out.
Sean
Thanks very much for taking the time to help me out.
Sean
Your very welcome. I don't know why the help for that function indicate that you can use the value instead of the constant. I think sometimes that the builtin constants are analyzed differently and may have some hidden bits turned on or off.
Glad that it worked.
Jim
Glad that it worked.
Jim
ASKER