Results 1 to 11 of 11
  1. #1
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Unanswered: The one thing I can't do

    I have been programming in Access for over eight years and I have one thing I want to do that I can not find any source for.

    What I want to do is create a button in a form that opens the file dialog manager, allows me to select a file and save that file in the database to my field (OLE object).

    I used to be able to drag and drop to get this done, but always wanted to automate it. Right now something is broken in the MS-Office setup or in the VBScript => Tools => References, because even drag and drop refuse to work now.

    I will appreciate help on both.

    Thanks!

  2. #2
    Join Date
    Nov 2003
    Posts
    267
    This is code that I copied off a forum (can't remember if it was here or not) I have never tested it, but like you, wanted it just in case I needed it. You have to use dlls to do this (unlike VB).

    Some one else may have tested code to give you.

    S




    Option Compare Database
    Option Explicit

    ' Code to display standard "Open File" dialog.

    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

    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean

    Private Const ALLFILES = "All files"

    Function MakeFilterString(ParamArray varFilt() As Variant) As String
    ' Create filter string.
    ' Returns "" if there are no arguments.
    ' Expects an even number of arguments (filter name, extension).
    ' Adds *.* if the number of arguments is odd.

    Dim strFilter As String
    Dim intRes As Integer
    Dim intNum As Integer

    intNum = UBound(varFilt)
    If (intNum <> -1) Then
    For intRes = 0 To intNum
    strFilter = strFilter & varFilt(intRes) & vbNullChar
    Next
    If intNum Mod 2 = 0 Then
    strFilter = strFilter & "*.*" & vbNullChar
    End If

    strFilter = strFilter & vbNullChar
    End If

    MakeFilterString = strFilter
    End Function

    Private Sub InitOFN(OFN As OPENFILENAME)
    With OFN
    ' Initialize fields user doesn't want to know about
    .hwndOwner = hWndAccessApp
    .hInstance = 0
    .lpstrCustomFilter = vbNullString
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .lpTemplateName = 0
    .lCustData = 0
    .nMaxFile = 511
    .lpstrFileTitle = String(512, vbNullChar)
    .nMaxFileTitle = 511
    .lStructSize = Len(OFN)
    ' Use default filter if not specified.
    If .lpstrFilter = "" Then
    .lpstrFilter = MakeFilterString(ALLFILES)
    End If
    ' Pad lpstrFile with null chars.
    .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar)
    End With
    End Sub

    Function OpenDialog(OFN As OPENFILENAME) As Boolean
    Dim intRes As Integer
    InitOFN OFN
    intRes = GetOpenFileName(OFN)
    If intRes Then
    ' Remove trailing null chars from lpstrFile.
    With OFN
    .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
    End With
    End If
    OpenDialog = intRes
    End Function

    '_____________________________

    'The following subs are used on the form.
    '_____________________________

    'This sub is added to a Close Button.

    'Private Sub cmdClose_Click()
    ' On Error Resume Next
    ' DoCmd.Close acForm, Me.Name

    'End Sub
    '_______________________________

    'This button removes the picture
    'Picfile is the name in TABLE
    'imgPicture is the name of the field on the form

    'Private Sub cmdErasePic_Click()

    ' If Not IsNull([PicFile]) Then
    ' If MsgBox("The image will be removed from this record. Are you sure?", vbYesNo + vbQuestion) = vbYes Then
    ' [imgPicture].Picture = ""
    ' [PicFile] = Null
    ' SysCmd acSysCmdClearStatus
    ' End If
    ' End If
    'End Sub
    '________________________________

    'This sub is used together with module to open the dialog box

    'Private Sub cmdInsertPic_Click()
    ' Dim OFN As OPENFILENAME
    ' On Error GoTo Err_cmdInsertPic_Click

    ' ' Set options for dialog box.
    ' With OFN
    ' .lpstrTitle = "Images"
    ' If Not IsNull([PicFile]) Then .lpstrFile = [PicFile]
    ' .flags = &H1804 ' OFN_FileMustExist + OFN_PathMustExist + OFN_HideReadOnly
    ' .lpstrFilter = MakeFilterString("Image files (*.bmp;*.gif;*.jpg;*.wmf)", "*.bmp;*.gif;*.jpg;*.wmf", _
    ' "All files (*.*)", "*.*")
    ' End With

    ' If OpenDialog(OFN) Then
    ' [PicFile] = OFN.lpstrFile
    ' [imgPicture].Picture = [PicFile]
    ' SysCmd acSysCmdSetStatus, "Afbeelding: '" & [PicFile] & "'."
    ' End If
    ' Exit Sub

    'Err_cmdInsertPic_Click:
    ' MsgBox Err.Description, vbExclamation
    'End Sub
    '___________________________________

    'This sub placed in the Form_Current section.

    'Private Sub Form_Current()
    ' On Error GoTo HandleErr
    ' If Not IsNull([PicFile]) Then
    ' [imgPicture].Picture = [PicFile]
    ' SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'."
    ' Else
    ' [imgPicture].Picture = ""
    ' SysCmd acSysCmdClearStatus
    ' End If
    ' Exit Sub

    'HandleErr:
    ' If Err = 2220 Then
    ' [imgPicture].Picture = ""
    ' SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'"
    ' Else
    ' MsgBox Err.Description, vbExclamation
    ' End If
    'End Sub

  3. #3
    Join Date
    Jan 2004
    Posts
    8
    This requires some Windows API code.

    I have attached the API code that I found from searching on the web. It can be used to create a standard Windows file open or save dialog box. It will only return the file name as a string, so you will have to code from there to save the file into the field you want it in.

    I also have some routines that use the API calls that I will attach in my next post.

    Good luck
    Attached Files Attached Files

  4. #4
    Join Date
    Jan 2004
    Posts
    8
    Here is the sample code using the API calls.
    Attached Files Attached Files

  5. #5
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379
    Is this suppose to be in a .vbs file? and what is the filename?

    Originally posted by sbaxter
    This is code that I copied off a forum (can't remember if it was here or not) I have never tested it, but like you, wanted it just in case I needed it. You have to use dlls to do this (unlike VB).

    Some one else may have tested code to give you.

    S




    Option Compare Database
    Option Explicit

    ' Code to display standard "Open File" dialog.

    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

    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean

    Private Const ALLFILES = "All files"

    Function MakeFilterString(ParamArray varFilt() As Variant) As String
    ' Create filter string.
    ' Returns "" if there are no arguments.
    ' Expects an even number of arguments (filter name, extension).
    ' Adds *.* if the number of arguments is odd.

    Dim strFilter As String
    Dim intRes As Integer
    Dim intNum As Integer

    intNum = UBound(varFilt)
    If (intNum <> -1) Then
    For intRes = 0 To intNum
    strFilter = strFilter & varFilt(intRes) & vbNullChar
    Next
    If intNum Mod 2 = 0 Then
    strFilter = strFilter & "*.*" & vbNullChar
    End If

    strFilter = strFilter & vbNullChar
    End If

    MakeFilterString = strFilter
    End Function

    Private Sub InitOFN(OFN As OPENFILENAME)
    With OFN
    ' Initialize fields user doesn't want to know about
    .hwndOwner = hWndAccessApp
    .hInstance = 0
    .lpstrCustomFilter = vbNullString
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .lpTemplateName = 0
    .lCustData = 0
    .nMaxFile = 511
    .lpstrFileTitle = String(512, vbNullChar)
    .nMaxFileTitle = 511
    .lStructSize = Len(OFN)
    ' Use default filter if not specified.
    If .lpstrFilter = "" Then
    .lpstrFilter = MakeFilterString(ALLFILES)
    End If
    ' Pad lpstrFile with null chars.
    .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar)
    End With
    End Sub

    Function OpenDialog(OFN As OPENFILENAME) As Boolean
    Dim intRes As Integer
    InitOFN OFN
    intRes = GetOpenFileName(OFN)
    If intRes Then
    ' Remove trailing null chars from lpstrFile.
    With OFN
    .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
    End With
    End If
    OpenDialog = intRes
    End Function

    '_____________________________

    'The following subs are used on the form.
    '_____________________________

    'This sub is added to a Close Button.

    'Private Sub cmdClose_Click()
    ' On Error Resume Next
    ' DoCmd.Close acForm, Me.Name

    'End Sub
    '_______________________________

    'This button removes the picture
    'Picfile is the name in TABLE
    'imgPicture is the name of the field on the form

    'Private Sub cmdErasePic_Click()

    ' If Not IsNull([PicFile]) Then
    ' If MsgBox("The image will be removed from this record. Are you sure?", vbYesNo + vbQuestion) = vbYes Then
    ' [imgPicture].Picture = ""
    ' [PicFile] = Null
    ' SysCmd acSysCmdClearStatus
    ' End If
    ' End If
    'End Sub
    '________________________________

    'This sub is used together with module to open the dialog box

    'Private Sub cmdInsertPic_Click()
    ' Dim OFN As OPENFILENAME
    ' On Error GoTo Err_cmdInsertPic_Click

    ' ' Set options for dialog box.
    ' With OFN
    ' .lpstrTitle = "Images"
    ' If Not IsNull([PicFile]) Then .lpstrFile = [PicFile]
    ' .flags = &H1804 ' OFN_FileMustExist + OFN_PathMustExist + OFN_HideReadOnly
    ' .lpstrFilter = MakeFilterString("Image files (*.bmp;*.gif;*.jpg;*.wmf)", "*.bmp;*.gif;*.jpg;*.wmf", _
    ' "All files (*.*)", "*.*")
    ' End With

    ' If OpenDialog(OFN) Then
    ' [PicFile] = OFN.lpstrFile
    ' [imgPicture].Picture = [PicFile]
    ' SysCmd acSysCmdSetStatus, "Afbeelding: '" & [PicFile] & "'."
    ' End If
    ' Exit Sub

    'Err_cmdInsertPic_Click:
    ' MsgBox Err.Description, vbExclamation
    'End Sub
    '___________________________________

    'This sub placed in the Form_Current section.

    'Private Sub Form_Current()
    ' On Error GoTo HandleErr
    ' If Not IsNull([PicFile]) Then
    ' [imgPicture].Picture = [PicFile]
    ' SysCmd acSysCmdSetStatus, "Image: '" & [PicFile] & "'."
    ' Else
    ' [imgPicture].Picture = ""
    ' SysCmd acSysCmdClearStatus
    ' End If
    ' Exit Sub

    'HandleErr:
    ' If Err = 2220 Then
    ' [imgPicture].Picture = ""
    ' SysCmd acSysCmdSetStatus, "Can't open image: '" & [PicFile] & "'"
    ' Else
    ' MsgBox Err.Description, vbExclamation
    ' End If
    'End Sub

  6. #6
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379
    Never mind, I have a senior moment. Class Module of course! Dummy me.

    The part in your code that I don't figure is:

    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

    I'm not familiar with this syntax.

    Clue me in!


    Originally posted by dbsupport4me
    Is this suppose to be in a .vbs file? and what is the filename?

  7. #7
    Join Date
    Nov 2003
    Location
    San Francisco, CA USA
    Posts
    59

    Structure??

    It looks like it's creating an Abstract Data Type called OPENFILENAME. Can someone confirm that? I've only just returned to Access after a long hiatus and so I am thinking in C/C++.

    If it is a structure-y/class-y thing, it allows you to declare a "variable" of type OPENFILENAME

    (How do we use it in Access? Is it DIM myFile As OPENFILENAME???)

    Then you'd have a variable with all kind of attributes without having to do all the explicit definitions.

    Then again...

    ...maybe not.

    I'm really curious now.

    Magee

  8. #8
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Talking New Post

    Sorry,

    Been to busy to test out this code, but have another problem. Will post a new string for it.

  9. #9
    Join Date
    Sep 2003
    Location
    The extremely Royal borough of Kensington, London
    Posts
    778
    The common Dialog Box control should be sufficent to solve your problem.

    openFile is an instance of the Common Dialog Box control.

    Private sub Button1_Click()
    Dim openFile As Object
    Set openFile = CreateObject("MSComDlg.CommonDialog")
    openFile.ShowOpen
    MsgBox openFile.FileName
    End Sub

    If you browse the properties of the Common Dialog Box, you will note the InitDir property. This is the initial directory that is displayed when the dialog box opens.
    Bessie Braddock: Winston, you are drunk!
    Churchill: And Madam, you are ugly. And tomorrow, I'll be sober, and you will still be ugly.

  10. #10
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379
    ??

  11. #11
    Join Date
    Feb 2004
    Location
    Irving, TX (Dallas, Fort Worth)
    Posts
    379

    Got to correct OLE issue first

    I'm having trouble with OLE. I posted another thread on it, because it won't work at all now. Can't make this code work if OLE won't work.

Posting Permissions

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