Sub inviamail()
Application.ScreenUpdating = False
Dim OutApp As Object
Dim EmailAddr As String
Dim subj As String
Dim BodyText As String
Sheets("Foglio1").Select
Columns("I:I").Select
Selection.NumberFormat = "$ #,##0.00"
'Range("I2:I6500").Activate
'Range("I2:I6500").NumberFormat = "#.##0,00"
Range("J2:J6500").NumberFormat = "mmmm/yyyy"
Range("O:P").ClearContents
rr = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To rr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.Createitem(0)
'On Error Resume Next
With OutMail
.To = Cells(i, 2)
.cc = Cells(i, 3)
.bcc = ""
.Subject = Cells(i, 4)
.body = "Si trasmette XXXXXXXXXXXXXXXXXXXXXXXXXXX." & _
" Pertanto XXXXXXXXXXXXXXX" & " " & Cells(i, 8) & ":" & " " & Cells(i, 10) & "." & Chr(13) & _
" Totale importo accreditato: € " & FormatNumber(Cells(i, 9), 2, , , -1) & _
Chr(13) & Chr(13) & Space(28) & "d'ordine" & Chr(13) & " XXXXXXXXX" & Chr(13) & Space(19) & "XXXXXX" & _
Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Si prega di fornire, con stesso mezzo, cortese cenno di riscontro."


'Cells(I, 5) & Trim(Cells(I, 8)) & " " & "Totale importo accreditato:"
.Attachments.Add (Cells(i, 6) & Cells(i, 7))
'.display questo comando visualizza la finestra del messaggio di outlook e in caso di
' invio di email multiple fa sfarfallare il monitor
.send
Application.SendKeys "%I" ' non fa uscire la finestra di Outlook che autorizza l'invio
End With
'On Error Resume Next 'con questo comando anche in caso di errore va avanti
On Error GoTo ERRORE
Cells(i, 15) = "INVIATA"
Set OutMail = Nothing
Set OutApp = Nothing
Application.SendKeys "%I"
Next i
ERRORE:
Cells(i, 16) = "ERRORE, NON INVIATA"
MsgBox ("La mail non è stata inviata alla seguente finanziaria :") & Cells(i, 11).Value
'If Cells(i, 16) = "ERRORE, NON INVIATA" Then
'MsgBox ("mail non inviata a:") & ActiveCell.Offset(0, -6).Value
'End If
Application.ScreenUpdating = True
Resume Next
MsgBox ("Invio multimail completato")
End Sub

I sistemi operativi Microsoft da XP e successive versione permettono la gestione grafica dei file compressi dello standard .ZIP, tuttavia non vi è inclusa una utility da poter utilizzare da linea di comando e quindi automatizzare una procedura di compressione.
In rete si trovano diversi script per creare file ZIP attraverso l'esecuzione di una procedura VBA.
 
Qui di seguito elenco due tipologie di vbscript per produrre file zip:
 1. Riporto di seguito lo script per windows xp che produce file .ZIP.
 2. Creare il file crea_zip.vbs e copiarci il seguente codice:
 
Option Explicit

Const FOF_CREATEPROGRESSDLG = &H0&
Dim sSourceFolder
Dim sArchiveFile
Dim oShell
Dim oZIP
Dim oSourceFolder

'Settaggio Variabili
sSourceFolder = "C:Test"
sArchiveFile = "C:ip_Out.ZIP"

Dim oFSO
Dim oFile
Dim iFiles
Dim Fldr

Set oFSO = CreateObject( "Scripting.FileSystemObject" )
Set oFile = oFSO.OpenTextFile( sArchiveFile , 2, True )
oFile.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing

iFiles = 0

With CreateObject("Shell.Application")

  'Copy the files to the compressed folder
  
 
   .NameSpace(sArchiveFile).CopyHere .NameSpace( sSourceFolder ).Items, FOF_CREATEPROGRESSDLG

  iFiles = iFiles + .NameSpace( sSourceFolder ).Items.Count

  'Keep script waiting until Compressing is done
  On Error Resume Next
  Do Until .NameSpace( sArchiveFile ).Items.Count = iFiles
   wScript.Sleep 1000
  Loop
  On Error GoTo 0
   
End With



Lo script esegue la creazione del file "C:ip_Out.ZIP" e lo riempie con i file della cartella "C:Test". 

Tuttavia se all'interno di C:Test risultano cartelle vuote si potrebbe generare un errore.