hello forum,
I've done a VBA code to send faxes via a mail merge in excel.
I'm using the Faxination program that allows to send faxes via Outlook.
I have 1 question related to this method: some of the receipients I've sent faxes using this, have complained that they are receiving the same fax 3 times.
is there any bug known for this solution, or am I missing something?
below is an excerpt of the code.
any help would be most appreciated
I've done a VBA code to send faxes via a mail merge in excel.
I'm using the Faxination program that allows to send faxes via Outlook.
I have 1 question related to this method: some of the receipients I've sent faxes using this, have complained that they are receiving the same fax 3 times.
is there any bug known for this solution, or am I missing something?
below is an excerpt of the code.
any help would be most appreciated
Code:
For Each cell In Columns("O").Cells.SpecialCells(xlCellTypeConstants)
If Application.WorksheetFunction.IsNumber(cell.Value) Then
'if the COntact type is avaialble - FAX or EMAIL
If cell.Offset(0, 6).Value <> "na" Then
'check if the email has already been sent
If IsEmpty(cell.Offset(0, 9).Value) And IsEmpty(cell.Offset(0, 10).Value) Then
Application.StatusBar = "Sending notification " & (cell.Offset(0, 11).Row - 1) & " / " & WorksheetFunction.CountIf(Range("Z2:Z" & Range("Z" & Rows.Count).End(xlUp).Row), "<>NO CONTACT")
'creating the excel file for email sending
If cell.Offset(0, 7).Value = "FAX" Then
'setting the range for each statement of acct
Set Rng = Range(Cells(cell.Offset(0, 2).Value, 1), Cells(cell.Offset(0, 3).Value, LC))
'sets the header for each soa
Set Header = Range(Cells(1, 1), Cells(1, LC))
Set Data = Union(Header, Rng)
Data.Select
Set Source = Selection.Copy
TempFilePath = ThisWorkbook.Path & "\"
TempFileName = "Fatture_codice_clienti_" & cell.Offset(0, 0) & "_" & Format(Now, "dd-mm-yyyy")
Set wbk = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
With Dest.Sheets(1).Range("A35")
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
For i = 1 To LC
Columns(i).AutoFit
Next i
End With
PDF_name = cell.Offset(0, 0).Value
'inserting the notification text in notification
Cells(1, 1) = subject_msg & " | " & cell.Offset(0, 0).Value & " | " & "; P.IVA " & cell.Offset(0, 13) & " | " & Format(Now, "dd-mm-yyyy")
Cells(3, 1) = msg(1)
Cells(5, 1) = msg(2)
Cells(6, 1) = msg(3) & cell.Offset(0, 4).Value
Cells(7, 1) = msg(4) & cell.Offset(0, 5).Value
Cells(9, 1) = msg(5) & cell.Offset(0, 12).Value
With ActiveSheet.PageSetup
.Orientation = xlLandscape
'.FitToPagesWide = 1
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.LeftHeader = "Page &P of &N"
.CenterHeader = ""
.RightHeader = "&D &T"
.LeftFooter = ""
.CenterFooter = "&G"
.RightFooter = ""
End With
'saving the notification as PDF file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Mypath & "\" & PDF_name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
DestPDF = Mypath & "\" & PDF_name & ".pdf"
'If Val(Application.Version) < 12 Then
' You are using Excel 2000 or 2003.
FileExtStr = ".xls": FileFormatNum = -4143
' Else
' You are using Excel 2007 or 2010.
'FileExtStr = ".xlsx": FileFormatNum = 51
' End If
' Dest.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
'Create the email message for each line from column A
Set OutlookMsg = Outlook.CreateItem(olMailItem)
With OutlookMsg
' set basic params
.Subject = ""
.HTMLBody = ""
.Attachments.Add DestPDF, olByValue, 1
.To = cell.Offset(0, 8).Value
' .ReplyRecipients.Add "[EMAIL="DzialRozliczen@astrazeneca.com"]DzialRozliczen@astrazeneca.com[/EMAIL]"
.Send
End With
cell.Offset(0, 9).Value = Format(Now, "dd-mmm-yy hh:mm")
cell.Offset(0, 10).Value = Application.UserName
Dest.Close savechanges:=False
Kill DestPDF
counter = counter + 1
End If
End If
End If
