Results 1 to 7 of 7
  1. #1
    Join Date
    Feb 2004
    Posts
    6

    Unanswered: access VBA how to emulate menu commands

    What I currently have is a command button that imports a XLS file into an already existing table in Access 2000 from a specific folder, after the file is imported it is then moved to a folder called 'Completed'. *The code for this is at the end of the thread.* Any help wuld be appreciated.
    Thanx.

    So Now what im trying to do is to get two form command buttons by emulating the 'File -> Get External Data -> Import' command.

    1. Import XLS File
    2. Import CSV File

    When either of the command buttons are clicked the same action that happens when u go to 'File -> Get External Data -> Import' should take place (the box that pops up)and the file should be imported to the specific table i want and then you should be able to append the data. Is this possible?


    *Solution* (Folder name - 'Test', Table name - 'Travel')
    Dim filename As String
    Dim filecheck As Boolean
    Dim syntax As String
    Dim itemcount As Integer

    itemcount = 0

    filename = Dir("C:\Test\*.xls")

    While filename <> ""
    filecheck = True

    DoCmd.SetWarnings False

    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "Travel", "C:\Test\Additional US Chapter Agents-Connecticut.xls", True



    'moves file to a different directory
    FileCopy "C:\Test\" & filename, "C:\Test\Completed\" & filename
    Kill "C:\Test\" & filename

    DoCmd.SetWarnings True

    MsgBox "The Database has been updated - XLS file successfully moved to 'Completed' folder.", 0, "Auto-Import Process Complete"

    filename = Dir()
    Wend

    If filecheck = False Then
    MsgBox "There were no files found to import."
    End If
    End Sub

  2. #2
    Join Date
    Jan 2004
    Location
    The Netherlands
    Posts
    421
    You are already doing that arent you?

    Except for CSV you should use transfertext instead of transferspreadsheet.

    Regards

  3. #3
    Join Date
    Feb 2004
    Posts
    6
    Originally posted by namliam
    You are already doing that arent you?

    Except for CSV you should use transfertext instead of transferspreadsheet.

    Regards
    Yes I am in a way but what i want the box to open up so the user can choose the desired file...rite now i have to place the xls file in a specific folder to import it. not very user friendly. hence if i culd get the code which access uses for the File;Get External Data;Import my problem would be solved. anyone know anythin about it?

  4. #4
    Join Date
    Jan 2004
    Location
    The Netherlands
    Posts
    421
    I get what your getting at but i lost my brains i guess, cause i for the life of me cannot remember how to call the file interface.

    After the interface you would still have to do docmd.transfer....
    but the folder\file would be returned from that... Sorry *FriedBrain*

    Regards

  5. #5
    Join Date
    Feb 2004
    Location
    Dorset UK
    Posts
    147
    right, this code isnt mine, and I cannot remember where It came from but it gives you the windows file browser.

    First create a module in your Database then copy this in:

    Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    End Type
    Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
    Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
    Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
    Global Const ahtOFN_READONLY = &H1
    Global Const ahtOFN_OVERWRITEPROMPT = &H2
    Global Const ahtOFN_HIDEREADONLY = &H4
    Global Const ahtOFN_NOCHANGEDIR = &H8
    Global Const ahtOFN_SHOWHELP = &H10
    Global Const ahtOFN_NOVALIDATE = &H100
    Global Const ahtOFN_ALLOWMULTISELECT = &H200
    Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
    Global Const ahtOFN_PATHMUSTEXIST = &H800
    Global Const ahtOFN_FILEMUSTEXIST = &H1000
    Global Const ahtOFN_CREATEPROMPT = &H2000
    Global Const ahtOFN_SHAREAWARE = &H4000
    Global Const ahtOFN_NOREADONLYRETURN = &H8000
    Global Const ahtOFN_NOTESTFILECREATE = &H10000
    Global Const ahtOFN_NONETWORKBUTTON = &H20000
    Global Const ahtOFN_NOLONGNAMES = &H40000
    Global Const ahtOFN_EXPLORER = &H80000
    Global Const ahtOFN_NODEREFERENCELINKS = &H100000
    Global Const ahtOFN_LONGNAMES = &H200000
    Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", _
    "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
    Filter:=strFilter, FilterIndex:=2, Flags:=lngFlags, _
    DialogTitle:="Hello! Open Me!")
    End Function
    Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
    ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
    varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
    varTitleForDialog = ""
    End If
    strFilter = ahtAddFilterItem(strFilter, "Access (*.mdb)", "*.MDB;*.MDA")
    'varFileName = ahtCommonFileOpenSave( _
    OpenFile:=True, _
    InitialDir:=varDirectory, _
    Filter:=StrFilter, _
    Flags:=lngFlags, _
    DialogTitle:=varTitleForDialog)
    varFileName = ahtCommonFileOpenSave( _
    OpenFile:=True, _
    Filter:=strFilter, _
    Flags:=lngFlags, _
    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
    varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
    End Function
    Function ahtCommonFileOpenSave( _
    Optional ByRef Flags As Variant, _
    Optional ByVal InitialDir As Variant, _
    Optional ByVal Filter As Variant, _
    Optional ByVal FilterIndex As Variant, _
    Optional ByVal DefaultExt As Variant, _
    Optional ByVal FileName As Variant, _
    Optional ByVal DialogTitle As Variant, _
    Optional ByVal hwnd As Variant, _
    Optional ByVal OpenFile As Variant) As Variant
    Dim OFN As tagOPENFILENAME
    Dim strFileName As String
    Dim strFileTitle As String
    Dim fResult As Boolean
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    With OFN
    .lStructSize = Len(OFN)
    .hwndOwner = hwnd
    .strFilter = Filter
    .nFilterIndex = FilterIndex
    .strFile = strFileName
    .nMaxFile = Len(strFileName)
    .strFileTitle = strFileTitle
    .nMaxFileTitle = Len(strFileTitle)
    .strTitle = DialogTitle
    .Flags = Flags
    .strDefExt = DefaultExt
    .strInitialDir = InitialDir
    .hInstance = 0
    .strCustomFilter = ""
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .strCustomFilter = String(255, 0)
    .nMaxCustFilter = 255
    End With

    If OpenFile Then
    fResult = aht_apiGetOpenFileName(OFN)
    Else
    fResult = aht_apiGetSaveFileName(OFN)
    End If

    If fResult Then

    If Not IsMissing(Flags) Then Flags = OFN.Flags
    ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
    ahtCommonFileOpenSave = vbNullString
    End If
    End Function
    Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
    strDescription & vbNullChar & _
    varItem & vbNullChar
    End Function
    Private Function TrimNull(ByVal strItem As String) As String
    Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
    TrimNull = Left(strItem, intPos - 1)
    Else
    TrimNull = strItem
    End If
    End Function

    '----------------------------

    Right now use this in your code, under your command button

    '----------------------

    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.Xls")

    StrInputFileName = ahtCommonFileOpenSave(InitialDir:=CDir, Filter:=strFilter, OpenFile:=True, DialogTitle:="Select a File...", Flags:=ahtOFN_HIDEREADONLY)


    If Len(Trim(StrInputFileName)) = 0 Then Exit Sub 'this quits if no file selected
    '-----------------------

    Now StrInputFileName is your filename...Its the only way I have found to do this.

    Hope it helps, and remember I didnt work this out, I got it from somewhere years ago, so I dont get any credit for this, although I basically understand it !!!

  6. #6
    Join Date
    Feb 2004
    Posts
    6
    Hey thanx for the help but a Compile Error saying cant find project or library comes up when i run the command button on this line

    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.Xls")

    the second strFilter is highlighted.


    Private Sub Command21_Click()
    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.Xls")

    StrCaribbeanB2B.xls = ahtCommonFileOpenSave(InitialDir:=CDir, Filter:=strFilter, OpenFile:=True, DialogTitle:="Select a File...", Flags:=ahtOFN_HIDEREADONLY)


    If Len(Trim(StrCaribbeanB2B.xls)) = 0 Then Exit Sub

    End Sub

  7. #7
    Join Date
    Feb 2004
    Location
    Dorset UK
    Posts
    147
    Sorry I think I may have confused you

    StrInputFileName is the variable that will become your filename.


    If you overtype to put exactly what I typed there, when you run it you will get the 'open dialog' box. (I hope!!)

    So if you run the code, and were to say msgbox StrInputFileName the msgbox would read "StrCaribbeanB2B.xls" if thats the file you selected.

    Dont alter any of the lines (unless you want to add more filters)

    Ken.

    Eg:

    Private Sub Command21_Click()
    strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.Xls")

    StrInputFileName = ahtCommonFileOpenSave(InitialDir:=CDir, Filter:=strFilter, OpenFile:=True, DialogTitle:="Select a File...", Flags:=ahtOFN_HIDEREADONLY)


    If Len(Trim(StrInputFileName )) = 0 Then Exit Sub

    msgbox StrInputFileName

    End Sub
    Last edited by Ken_Hart; 02-27-04 at 04:37.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •