By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,665 Members | 1,367 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,665 IT Pros & Developers. It's quick & easy.

VBA to import Excel File to Access table

P: 3
Hello,

I have the following code that I am using when a user presses a button to import an excel file into a table. The code is hard coded to point to the correct table. This works great for this one table. My problem is I have two buttons I want to use this code for for the two buttons would put the data in different tables. I have tried copying and changing a few things and nothing will work for me. The code is set up in a module and then I have a macro named import that is RunCode TestFile() that is run on the button push.

Code>>
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. 'This code was originally written by Ken Getz.
  4. 'It is not to be altered or distributed,
  5. 'except as part of an application.
  6. 'You are free to use it in any application,
  7. 'provided the copyright notice is left unchanged.
  8. '
  9. ' Code courtesy of:
  10. ' Microsoft Access 95 How-To
  11. ' Ken Getz and Paul Litwin
  12. ' Waite Group Press, 1996
  13.  
  14. Type tagOPENFILENAME
  15.     lStructSize As Long
  16.     hwndOwner As Long
  17.     hInstance As Long
  18.     strFilter As String
  19.     strCustomFilter As String
  20.     nMaxCustFilter As Long
  21.     nFilterIndex As Long
  22.     strFile As String
  23.     nMaxFile As Long
  24.     strFileTitle As String
  25.     nMaxFileTitle As Long
  26.     strInitialDir As String
  27.     strTitle As String
  28.     flags As Long
  29.     nFileOffset As Integer
  30.     nFileExtension As Integer
  31.     strDefExt As String
  32.     lCustData As Long
  33.     lpfnHook As Long
  34.     lpTemplateName As String
  35. End Type
  36.  
  37. Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
  38.     Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
  39.  
  40. Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
  41.     Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
  42. Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
  43.  
  44. Global Const ahtOFN_READONLY = &H1
  45. Global Const ahtOFN_OVERWRITEPROMPT = &H2
  46. Global Const ahtOFN_HIDEREADONLY = &H4
  47. Global Const ahtOFN_NOCHANGEDIR = &H8
  48. Global Const ahtOFN_SHOWHELP = &H10
  49. ' You won't use these.
  50. 'Global Const ahtOFN_ENABLEHOOK = &H20
  51. 'Global Const ahtOFN_ENABLETEMPLATE = &H40
  52. 'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
  53. Global Const ahtOFN_NOVALIDATE = &H100
  54. Global Const ahtOFN_ALLOWMULTISELECT = &H200
  55. Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
  56. Global Const ahtOFN_PATHMUSTEXIST = &H800
  57. Global Const ahtOFN_FILEMUSTEXIST = &H1000
  58. Global Const ahtOFN_CREATEPROMPT = &H2000
  59. Global Const ahtOFN_SHAREAWARE = &H4000
  60. Global Const ahtOFN_NOREADONLYRETURN = &H8000
  61. Global Const ahtOFN_NOTESTFILECREATE = &H10000
  62. Global Const ahtOFN_NONETWORKBUTTON = &H20000
  63. Global Const ahtOFN_NOLONGNAMES = &H40000
  64. ' New for Windows 95
  65. Global Const ahtOFN_EXPLORER = &H80000
  66. Global Const ahtOFN_NODEREFERENCELINKS = &H100000
  67. Global Const ahtOFN_LONGNAMES = &H200000
  68.  
  69. Function TestIt()
  70.     Dim strFilter As String
  71.     Dim lngFlags As Long
  72.     strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
  73.                     "*.MDA;*.MDB")
  74.     strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
  75.     strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
  76.     strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
  77.     MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
  78.         Filter:=strFilter, FilterIndex:=3, flags:=lngFlags, _
  79.         DialogTitle:="Hello! Open Me!")
  80.     ' Since you passed in a variable for lngFlags,
  81.     ' the function places the output flags value in the variable.
  82.     Debug.Print Hex(lngFlags)
  83. End Function
  84.  
  85. Function GetOpenFile(Optional varDirectory As Variant, _
  86.     Optional varTitleForDialog As Variant) As Variant
  87. ' Here's an example that gets an Access database name.
  88. Dim strFilter As String
  89. Dim lngFlags As Long
  90. Dim varFileName As Variant
  91. ' Specify that the chosen file must already exist,
  92. ' don't change directories when you're done
  93. ' Also, don't bother displaying
  94. ' the read-only box. It'll only confuse people.
  95.     lngFlags = ahtOFN_FILEMUSTEXIST Or _
  96.                 ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
  97.     If IsMissing(varDirectory) Then
  98.         varDirectory = ""
  99.     End If
  100.     If IsMissing(varTitleForDialog) Then
  101.         varTitleForDialog = ""
  102.     End If
  103.  
  104.     ' Define the filter string and allocate space in the "c"
  105.     ' string Duplicate this line with changes as necessary for
  106.     ' more file templates.
  107.     strFilter = ahtAddFilterItem(strFilter, _
  108.                 "Access (*.mdb)", "*.MDB;*.MDA")
  109.     ' Now actually call to get the file name.
  110.     varFileName = ahtCommonFileOpenSave( _
  111.                     OpenFile:=True, _
  112.                     InitialDir:=varDirectory, _
  113.                     Filter:=strFilter, _
  114.                     flags:=lngFlags, _
  115.                     DialogTitle:=varTitleForDialog)
  116.     If Not IsNull(varFileName) Then
  117.         varFileName = TrimNull(varFileName)
  118.     End If
  119.     GetOpenFile = varFileName
  120. End Function
  121.  
  122. Function ahtCommonFileOpenSave( _
  123.             Optional ByRef flags As Variant, _
  124.             Optional ByVal InitialDir As Variant, _
  125.             Optional ByVal Filter As Variant, _
  126.             Optional ByVal FilterIndex As Variant, _
  127.             Optional ByVal DefaultExt As Variant, _
  128.             Optional ByVal FileName As Variant, _
  129.             Optional ByVal DialogTitle As Variant, _
  130.             Optional ByVal hwnd As Variant, _
  131.             Optional ByVal OpenFile As Variant) As Variant
  132. ' This is the entry point you'll use to call the common
  133. ' file open/save dialog. The parameters are listed
  134. ' below, and all are optional.
  135. '
  136. ' In:
  137. ' Flags: one or more of the ahtOFN_* constants, OR'd together.
  138. ' InitialDir: the directory in which to first look
  139. ' Filter: a set of file filters, set up by calling
  140. ' AddFilterItem. See examples.
  141. ' FilterIndex: 1-based integer indicating which filter
  142. ' set to use, by default (1 if unspecified)
  143. ' DefaultExt: Extension to use if the user doesn't enter one.
  144. ' Only useful on file saves.
  145. ' FileName: Default value for the file name text box.
  146. ' DialogTitle: Title for the dialog.
  147. ' hWnd: parent window handle
  148. ' OpenFile: Boolean(True=Open File/False=Save As)
  149. ' Out:
  150. ' Return Value: Either Null or the selected filename
  151. Dim OFN As tagOPENFILENAME
  152. Dim strFileName As String
  153. Dim strFileTitle As String
  154. Dim fResult As Boolean
  155.     ' Give the dialog a caption title.
  156.     If IsMissing(InitialDir) Then InitialDir = CurDir
  157.     If IsMissing(Filter) Then Filter = ""
  158.     If IsMissing(FilterIndex) Then FilterIndex = 1
  159.     If IsMissing(flags) Then flags = 0&
  160.     If IsMissing(DefaultExt) Then DefaultExt = ""
  161.     If IsMissing(FileName) Then FileName = ""
  162.     If IsMissing(DialogTitle) Then DialogTitle = ""
  163.     If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
  164.     If IsMissing(OpenFile) Then OpenFile = True
  165.     ' Allocate string space for the returned strings.
  166.     strFileName = Left(FileName & String(256, 0), 256)
  167.     strFileTitle = String(256, 0)
  168.     ' Set up the data structure before you call the function
  169.     With OFN
  170.         .lStructSize = Len(OFN)
  171.         .hwndOwner = hwnd
  172.         .strFilter = Filter
  173.         .nFilterIndex = FilterIndex
  174.         .strFile = strFileName
  175.         .nMaxFile = Len(strFileName)
  176.         .strFileTitle = strFileTitle
  177.         .nMaxFileTitle = Len(strFileTitle)
  178.         .strTitle = DialogTitle
  179.         .flags = flags
  180.         .strDefExt = DefaultExt
  181.         .strInitialDir = InitialDir
  182.         ' Didn't think most people would want to deal with
  183.         ' these options.
  184.         .hInstance = 0
  185.         '.strCustomFilter = ""
  186.         '.nMaxCustFilter = 0
  187.         .lpfnHook = 0
  188.         'New for NT 4.0
  189.         .strCustomFilter = String(255, 0)
  190.         .nMaxCustFilter = 255
  191.     End With
  192.     ' This will pass the desired data structure to the
  193.     ' Windows API, which will in turn it uses to display
  194.     ' the Open/Save As Dialog.
  195.     If OpenFile Then
  196.         fResult = aht_apiGetOpenFileName(OFN)
  197.     Else
  198.         fResult = aht_apiGetSaveFileName(OFN)
  199.     End If
  200.  
  201.     ' The function call filled in the strFileTitle member
  202.     ' of the structure. You'll have to write special code
  203.     ' to retrieve that if you're interested.
  204.     If fResult Then
  205.         ' You might care to check the Flags member of the
  206.         ' structure to get information about the chosen file.
  207.         ' In this example, if you bothered to pass in a
  208.         ' value for Flags, we'll fill it in with the outgoing
  209.         ' Flags value.
  210.         If Not IsMissing(flags) Then flags = OFN.flags
  211.         ahtCommonFileOpenSave = TrimNull(OFN.strFile)
  212.     Else
  213.         ahtCommonFileOpenSave = vbNullString
  214.     End If
  215. End Function
  216.  
  217. Function ahtAddFilterItem(strFilter As String, _
  218.     strDescription As String, Optional varItem As Variant) As String
  219. ' Tack a new chunk onto the file filter.
  220. ' That is, take the old value, stick onto it the description,
  221. ' (like "Databases"), a null character, the skeleton
  222. ' (like "*.mdb;*.mda") and a final null character.
  223.  
  224.     If IsMissing(varItem) Then varItem = "*.*"
  225.     ahtAddFilterItem = strFilter & _
  226.                 strDescription & vbNullChar & _
  227.                 varItem & vbNullChar
  228. End Function
  229.  
  230. Private Function TrimNull(ByVal strItem As String) As String
  231. Dim intPos As Integer
  232.     intPos = InStr(strItem, vbNullChar)
  233.     If intPos > 0 Then
  234.         TrimNull = Left(strItem, intPos - 1)
  235.     Else
  236.         TrimNull = strItem
  237.     End If
  238. DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Direct Pay Transactions", strItem, True ' the True is "has field Names"
  239.  
  240. End Function
  241. Private Sub cmdImport_Click()
  242.  
  243. ' Declare local variables.
  244. Dim strImportFile As String
  245.  
  246. ' Assign the value of the Import File Textbox to the local variable.
  247. 'strImportFile = Nz(Me.txtImportFile, "")
  248.  
  249. ' Turns the display of system messages off.
  250. DoCmd.SetWarnings False
  251.  
  252. ' Query that empties the "temp" import table (tblFleetAccountsPayableTEMP).
  253. 'DoCmd.OpenQuery "qryFleetAccountsPayableTEMPDELETE"
  254. 'Call TestFile
  255. ' Use the TransferSpreadsheet action to import data between the current Microsoft Access
  256. ' database (.mdb) or Access project (.adp) and a spreadsheet file (.xls).
  257. strItem = strImportFile
  258. DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Direct Pay Transactions", strImportFile, True ' the True is "has field Names"
  259.  
  260. ' Query that cleans up the imported data by removing all rows that contain "/" or "\" or "#"
  261. ' or "A" or "E" or "I" or "O" or "U" or "Y". Also removes rows where the Last 5 is greater
  262. ' or less than 5 digits from the tblFleetAccountsPayableTEMP table.
  263. DoCmd.OpenQuery "qryFleetAccountsPayableTEMPCLEANUPDELETE"
  264.  
  265. ' Move from "temp" table (tblFleetAccountsPayableTEMP) to final table (tblFleetAccountsPayable).
  266. DoCmd.OpenQuery "qryFleetAccountsPayableAPPEND"
  267.  
  268. ' Turns the display of system messages on.
  269. DoCmd.SetWarnings True
  270.  
  271. MsgBox "The Import Fleet Accounts Payable Process is complete! " & vbCrLf & _
  272. "Please verify that the Data in the Fleet Accounts Payable table is Correct. ", vbInformation, "Import Fleet AP Data"
  273.  
  274. ' Close the dlgImportFleetAccountsPayableData dialog.
  275. DoCmd.Close acForm, "dlgImportFleetAccountsPayableData"
  276.  
  277. ' Closes the background panel if loaded.
  278. 'If IsLoaded("frmBackground") Then
  279. 'DoCmd.Close acForm, "frmBackground"
  280. 'End If
  281.  
  282. End Sub
  283.  
  284. Function TestFile()
  285. Dim strFilter As String
  286. Dim strInputFileName As String
  287.  
  288. strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
  289. strInputFileName = ahtCommonFileOpenSave( _
  290.                 Filter:=strFilter, OpenFile:=True, _
  291.                 DialogTitle:="Please select an input file...", _
  292.                 flags:=ahtOFN_HIDEREADONLY)
  293. 'Call cmdImport_Click
  294. End Function
Aug 15 '09 #1
Share this Question
Share on Google+
6 Replies


RuralGuy
Expert 100+
P: 375
You would normally use:
StringVariable = GetOpenFile()
...to get a filename.
Aug 15 '09 #2

ADezii
Expert 5K+
P: 8,607
The 3rd Parameter of the TransferSpreadsheet Method is the Table Name. Instead of Hard-Coding it as in the example below:
Expand|Select|Wrap|Line Numbers
  1. DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Direct Pay Transactions", strItem, True 
  1. Declare a Public String Variable to contain the Value of the Table Name in a Standard Code Module:
    Expand|Select|Wrap|Line Numbers
    1. Public strTableName As String
  2. Modify the actual Line of Code that does the Import:
    Expand|Select|Wrap|Line Numbers
    1. DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTableName, strItem, True 
  3. In the Click() Event of each Command Button, set strTableName to the Name of the Table that will accept the Imported Excel Worksheet.
  4. Call the Main Routine.
    Expand|Select|Wrap|Line Numbers
    1. Private Sub Button1_Click()
    2.   strTableName = "Direct Pay Transactions"
    3.   'Execute the Entry/Main Routine
    4. End Sub
    Expand|Select|Wrap|Line Numbers
    1. Private Sub Button2_Click()
    2.   strTableName = "YaDa, YaDa, YaDa"
    3.   'Execute the Entry/Main Routine
    4. End Sub
  5. The more efficient approach (avoid Public Variable) would be to pass the Value of the Table Name to the Entry/Main Routine, which would have the Variable as an additional Argument, then process it.
    Expand|Select|Wrap|Line Numbers
    1. Private Sub Button1_Click()
    2.   'Call MainRoutine("Direct Pay Transactions")
    3. End Sub
    4.  
    Expand|Select|Wrap|Line Numbers
    1. Private Sub Button2_Click()
    2.   'Call MainRoutine("YaDa, YaDa, YaDa")
    3. End Sub
    4.  
    Expand|Select|Wrap|Line Numbers
    1. MainRoutine(strTableName As String)
    2.   DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTableName, strItem, True 
    3. End MainRoutine
    4.  
Aug 16 '09 #3

P: 3
Thank you for the help! I understand until I get to 'Execute the Entry/Main Routine

What do I put to execute the TestFile()? I am asuming that Is what I need to execute as the old Macro ran that.
Aug 16 '09 #4

ADezii
Expert 5K+
P: 8,607
@provor
I'm confused since this Funtion will do nothing more than display the Open File Dialog Box and place the Name of the Selected File into the Variable strInputFileName.
Aug 16 '09 #5

P: 3
I guess I do not know. I am new to VBA I have never used it before. But the project I am working on right now is using several vba components. It works as is right now. But It will only go to the table coded into the statment. Right now when I click the button it brings up the find file dialog and once selected the data from the excel sheet is automatically imported into the table. There is a macro that is just RunCode: TestFile(). The botton is just set to TestFile() onclick event. I was thinking I could copy the module and basically duplicate it but It will not work.
Aug 16 '09 #6

ADezii
Expert 5K+
P: 8,607
@provor
Since you are directly executing the Click() Event of a Command Button from the TestFile() Function, the easiest route for you to follow is to perform Steps 1 to 3 in Post #3, then modify code in the Click() Event of your 2 Command Buttons as follows:
Expand|Select|Wrap|Line Numbers
  1. Private Sub Button1_Click() 
  2.   strTableName = "Direct Pay Transactions" 
  3.   Call TestFile()
  4. End Sub 
Expand|Select|Wrap|Line Numbers
  1. Private Sub Button2_Click() 
  2.   strTableName = "YaDa, YaDa, YaDa"" 
  3.   Call TestFile()
  4. End Sub 
P.S.- DELETE the Macro that Runs the TestFile() Function.
Aug 17 '09 #7

Post your reply

Sign in to post your reply or Sign up for a free account.