On Error GoTo inviaFax_err

'--> creo il file di log
Dim nomeFileLog As String
nomeFileLog = "C:\liste\logFaxInvio_" & Format(Date, "ddmmyyyy") & ".txt"
Open nomeFileLog For Output As #1

'--> dichiarazione oggetti
Dim oFso As Scripting.FileSystemObject, oDoc As Object
Dim oFax As FaxServer, oFaxDoc As FaxDoc, JobId As Variant

'--> dichiarazione variabili
Dim numeroFaxDaComporre As String, posInizio As Integer

'--> creazione oggetti
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFax = CreateObject("FaxServer.FaxServer")

'--> inizio impostazione server fax
Print #1, "'--> inizio impostazione server fax"
With oFax
    .Connect "" '<-- creo una connessione (al pc), se stringa nulla é il pc locale
    .ArchiveDirectory = "C:\Documenti\Fax\Fax inviati" '<-- directory dove posizionare i fax inviati
    .ArchiveOutboundFaxes = 1 '<-- salvataggio di una copia del fax nella cartella
    .Branding = 1 '<-- scrivi intestazione del fax nel documento
    .DirtyDays = 5 '<-- giorni per ritentare l'invio se non riuscito
    .Retries = 1 '<-- numero ore per ritentare l'invio (del fax) non riuscito
    .RetryDelay = 5 '<-- numero minuti per ritentare l'invio (del fax) non riuscito
    .ServerCoverpage = 0 '<-- non invio la pagina di informazioni
    .UseDeviceTsid = 1 '<-- invio l'identificativo del fax che trasmette
End With
Print #1, "'--> fine impostazione server fax" '<-- fine impostazione server fax

'--> ciclo per ogni documento nella cartella dei fax
Print #1, "'--> ciclo per ogni documento nella cartella dei fax"
For Each oDoc In oFso.GetFolder("C:\liste\FaxDaInviare\").Files

'--> inizio creazione documento fax
'--> creazione documento fax
    Set oFaxDoc = oFax.CreateDocument("C:\liste\FaxDaInviare\" & oDoc.Name)

'--> inizio impostazione e invio documento fax
    posInizio = InStr(1, oDoc.Name, "_") + 1 '<-- posizione carattere underscore
    numeroFaxDaComporre = Mid(oDoc.Name, posInizio) '<-- tolgo i numeri prima del carattere underscore
    numeroFaxDaComporre = Left(numeroFaxDaComporre, Len(numeroFaxDaComporre) - 4) '<-- tolgo l'estensione del file e il punto

    With oFaxDoc
        .FaxNumber = "0" & numeroFaxDaComporre '<-- numero del fax
        Print #1, numeroFaxDaComporre & "'<-- numero del fax da comporre"
        On Error Resume Next '<-- verifica errore invio fax
        JobId = .Send '<-- invio fax
        Print #1, "'<-- invio fax: " & oDoc.Name

        If Err.Number <> 0 Then '<-- se si é verificato un errore
            Print #1, "Errore: " & Application.AccessError(Err.Number) & " su invio fax: " & oDoc.Name & ", JobId: " & JobId
        Else
            Print #1, "Fax: " & oDoc.Name & ", JobId: " & JobId & "...Inviato."
        End If
    End With
'--> fine impostazione documento fax

    On Error GoTo 0 '<-- ripristino la gestione degli errori

'--> fine creazione documento fax
    Set oFaxDoc = Nothing
Next

On Error GoTo 0 '<-- reimposto la gestione degli errori

inviaFax_exit:
    Print #1, "Disconnessione dal server fax."
    oFax.Disconnect '<-- disconnetto il server fax
    Print #1, "'--> distruggo gli oggetti"
'--> distruggo gli oggetti
    Set oFso = Nothing
    Set oFax = Nothing
    Print #1, "Invio fax terminato."
    Close #1
    Exit Sub

inviaFax_err:
    Print #1, "Disconnessione dal server fax."
    Print #1, "'--> distruggo gli oggetti"
'--> distruggo gli oggetti
    Set oFso = Nothing
    Set oDoc = Nothing
    Set oFax = Nothing
    Set oFaxDoc = Nothing
    Set JobId = Nothing
    Print #1, Application.AccessError(Err.Number), vbCritical + vbOKOnly, "Routine InviaFax - Errore"
    Close #1