L’invio di Email dal database di Access che contiene un allegato con nome dinamico

Non so come far funzionare questo aggeggio al di là di questo punto.
Il mio codice riportato di seguito invia una e-mail contenente un allegato di MS Access 2010.

Il problema è che se si richiede un file fisso nome, il mio nome file viene modificato come io sto usando la data alla fine di ogni file. esempio: green_12_04_2012.csv. Anche io non so come fare questo non fallire se la cartella è vuota o la directory modifiche. Sarebbe bello per saltare al successivo sub piuttosto che bloccarsi.

Il Mio Codice:

Dim strGetFilePath As String
Dim strGetFileName As String

strGetFilePath = "C:\datafiles\myfolder\*.csv"

strGetFileName = Dir(strGetFilePath)

Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .BodyFormat = olFormatRichText
    .To = "[email protected]"
    ''.cc = ""
    ''.bcc = ""
    .Subject = "text here"
    .HTMLBody = "text here"
    .Attachments.Add (strGetFileName & "*.csv")
    .Send
End With
End Sub

Penso di arrivarci.

 

2 Replies
  1. 3

    Ho trovato una risoluzione adatta e in aggiunta alla soluzione postato, ho voluto aggiungere questo in caso qualcuno è in cerca di una soluzione. Sono stato fino alle 3 del mattino, questo è un molto popolare domanda, ma non c’era alcuna risoluzione in materia di ciclo di un collegamento di tutti i file in una cartella specifica.

    Ecco il codice:

    Public Sub sendEmail()
        Dim appOutLook As Outlook.Application
        Dim MailOutLook As Outlook.MailItem
        Dim strPath As String
        Dim strFilter As String
        Dim strFile As String
    
        strPath = "C:\Users\User\Desktop\"      'Edit to your path
        strFilter = "*.csv"
        strFile = Dir(strPath & strFilter)
    
        If strFile <> "" Then
    
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
    
            With MailOutLook
                .BodyFormat = olFormatRichText
                .To = "[email protected]"
                ''.cc = ""
                ''.bcc = ""
                .Subject = "text here"
                .HTMLBody = "text here"
                .Attachments.Add (strPath & strFile)
                .Send
                '.Display    'Used during testing without sending (Comment out .Send if using this line)
            End With
        Else
            MsgBox "No file matching " & strPath & strFilter & " found." & vbCrLf & _
                    "Processing terminated.
            Exit Sub    'This line only required if more code past End If
        End If
    
    End Sub
    
  2. 0

    ecco il codice che ho trovato su un forum e non ricordo dove, ma l’ho modificata leggermente
    questo ti dà il percorso completo del file, la ricerca di cartelle e sottocartelle utilizzando il carattere jolly

    Function fSearchFileWild(FileName As String, Extenstion As String)
    Dim strFileName As String
    Dim strDirectory As String
    
    strFileName = "*" & FileName & "*." & Extenstion
    strDirectory = "C:\Documents and Settings\"
    
    fSearchFileWild = ListFiles(strDirectory, strFileName, True)
    
    End Function
    
    Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
        Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
    On Error GoTo Err_Handler
    
    Dim colDirList As New Collection
    Dim varItem As Variant
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
    Dim counter As Integer
    counter = 0
    Dim file1 As String
    Dim file2 As String
    Dim file3 As String
    
    
    For Each varItem In colDirList
        If file1 = "" Then
        file1 = varItem
        counter = 1
        ElseIf file2 = "" Then
        file2 = varItem
        counter = 2
        ElseIf file3 = "" Then
        file3 = varItem
        counter = 3
        End If
    Next
    'if there is more than 1 file, msgbox displays first 3 files
    If counter = 1 Then
    ListFiles = file1
    ElseIf counter > 1 Then
    MsgBox "Search has found Multiple files for '" & strFileSpec & "', first 3 files are: " & vbNewLine _
            & vbNewLine & "file1: " & file1 & vbNewLine _
            & vbNewLine & "file2: " & file2 & vbNewLine _
            & vbNewLine & "file3: " & file3
    ListFiles = "null"
    Else
    ListFiles = "null"
    End If
    
    
    
    Exit_Handler:
    
        Exit Function
    
    
    Err_Handler:
    
        MsgBox "Error " & Err.Number & ": " & Err.Description
    
        Resume Exit_Handler
    
    End Function
    
    Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
        bIncludeSubfolders As Boolean)
        'Build up a list of files, and then add add to this list, any additional folders
        Dim strTemp As String
        Dim colFolders As New Collection
        Dim vFolderName As Variant
    
        'Add the files to the folder.
        strFolder = TrailingSlash(strFolder)
        strTemp = Dir(strFolder & strFileSpec)
        Do While strTemp <> vbNullString
            colDirList.Add strFolder & strTemp
            strTemp = Dir
        Loop
    
        If bIncludeSubfolders Then
            'Build collection of additional subfolders.
            strTemp = Dir(strFolder, vbDirectory)
            Do While strTemp <> vbNullString
                If (strTemp <> ".") And (strTemp <> "..") Then
                    If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                        colFolders.Add strTemp
                    End If
                End If
                strTemp = Dir
            Loop
            'Call function recursively for each subfolder.
            For Each vFolderName In colFolders
                Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
            Next vFolderName
        End If
    End Function
    
    Public Function TrailingSlash(varIn As Variant) As String
        If Len(varIn) > 0& Then
            If Right(varIn, 1&) = "\" Then
                TrailingSlash = varIn
            Else
                TrailingSlash = varIn & "\"
            End If
        End If
    End Function
    
    • Ciao e grazie per l’risponde, così come chiamare questo nel mio codice?
    • sostituire strGetFileName = Dir(strGetFilePath) con strGetFileName = fSearchFileWild(“verde”,”csv”)

Lascia un commento