VBA FileDialog InitialFileName with Outlook mail Attachments (1 Viewer)

[jmaty23]

I am trying to have a file dialog open to the outlook attachments folder to allow the user to copy the attachment to a file store. When I set the outlook attachment file path as the initialfilename in the dialog, it defaults the initial folder to My Documents. Any thoughts?

Private Sub cmdAddOutlook_Click()
If ErrOn Then On Error GoTo ErrorHandler

Dim objDialog As Object
Dim sFile As String
Dim strOriginalPath As String
Dim strPRPath As String
Dim strFileName As String
Dim strNewPAth As String
Dim lngPOID As Long
Dim lngAttachID As Long

    lngPOID = Forms!frmPurchaseOrderDetail!txtID
    strPRPath = GetFilePath(1) & "\" & lngPOID
    Set objDialog = Application.FileDialog(3)

With objDialog
        .initialfilename = "C:\Users\*****\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\B4XT4KAQ"
        .Title = "Select PDF File"
        .Filters.Clear
        .Filters.Add "PDF", "*.pdf"
        .AllowMultiSelect = False
        If .Show Then
            sFile = objDialog.SelectedItems(1)
            strOriginalPath = sFile
        Else
            GoTo ProcedureExit
        End If
    End With
Set objDialog = Nothing

Call CheckDir(strPRPath)

strFileName = Right$(strOriginalPath, Len(strOriginalPath) - InStrRev(strOriginalPath, "\"))
strNewPAth = strPRPath & "\" & strFileName

Dim db As DAO.Database
Dim rst As DAO.Recordset
    Set db = CurrentDb
    Set rst = db.OpenRecordset("tblPurchaseOrderAttachments", dbOpenDynaset, dbSeeChanges)
        With rst
            .AddNew
            !POID = lngPOID
            !DocumentType = "PDF"
            !DocumentPath = strNewPAth
            !DateAdd = Now
            !Username = GetActiveUser
            .Update
        End With
    rst.Close

    Call FileCopy(strOriginalPath, strNewPAth)

Me.subItems.Requery
    
ProcedureExit:
    Set rst = Nothing
    Set db = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "Error" & ":  " & Err.Number & vbCrLf & "Description: " _
        & Err.Description, vbExclamation, Me.Name & ".cmdAddOutlook_Click"
    Resume ProcedureExit

End Sub

 

[Ranman256]

'mis read the initial code.

you could always send the path to the code as a param.