Hi
Cananyone help me to short out this when i am sending mails through macros after some mails macro stop in the line "CopyToClipboard"
my code in macro is
Folder = "e:\DocAdmin\BLARS-WeeklyReport\"
Function printReportPDF(pdfOutputFile)
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.RegWrite "HKCU\Software\QlikViewPDF\OutputFile", pdfOutputFile, "REG_SZ"
WSHShell.RegWrite "HKCU\Software\QlikViewPDF\BypassSaveAs", "1", "REG_SZ"
Set WSHShell = nothing
End function
sub field
dim x
ActiveDocument.Fields("Agency").SelectAll
set arrweek=ActiveDocument.Variables("CurrentWeek")
week=arrweek.GetContent.String
set arryer=ActiveDocument.Variables("CY")
yer=arryer.GetContent.String
set arrAgencia= ActiveDocument.Fields("Agency").GetSelectedValues("500")
for i=0 to arrAgencia.Count-1
Agenci=(arrAgencia.Item(i).Text)
ActiveDocument.Fields("Agency").Select(Agenci)
set PC=ActiveDocument.Variables("prec")
PC1=PC.GetContent.String
PC2=Int(PC1)
set arrmail=ActiveDocument.Fields("sendMailTo").GetPossibleValues
for l=0 to arrmail.Count-1
mail=(arrmail.Item(l).Text)
set arrmaill=ActiveDocument.Fields("sendCC").GetPossibleValues
for k=0 to arrmaill.Count-1
maill=(arrmaill.Item(k).Text)
set arrmailll=ActiveDocument.Variables("fromMail")
mailll=arrmailll.GetContent.String
ActiveDocument.PrintReport("RP01"), "QlikViewPDF", false
reportFile = Folder & Agenci & "- Wk-" & yer & "-" & week & ".pdf"
printReportPDF(reportFile)
'if Ctry<>"Brazil" then
set XLApp = CreateObject("Excel.Application")
XLApp.Visible = false
set XLDoc = XLApp.Workbooks.Add
XLDoc.Sheets.Add.Name= "Discrepancies"
set obj= ActiveDocument.getSheetObject("TB05")
obj.CopyTableToClipboard true
XLApp.Worksheets(1).Range("A1").Select()
XLApp.Worksheets(1).Paste()
XLDoc.Worksheets("Discrepancies").Columns("A:Z").ColumnWidth= 50
XLDoc.Worksheets("Discrepancies").Cells.EntireRow.AutoFit
XLDoc.Worksheets("Discrepancies").Cells.EntireColumn.AutoFit
ActiveDocument.ClearAll false
XLDoc.Worksheets("Discrepancies").Columns("A:Z").ColumnWidth= 50
XLDoc.Worksheets("Discrepancies").Cells.EntireRow.AutoFit
XLDoc.Worksheets("Discrepancies").Cells.EntireColumn.AutoFit
XLDoc.Worksheets("Discrepancies").Range("A:Z").Borders.ColorIndex=0
XLDoc.Worksheets("Discrepancies").Select
XLApp.DisplayAlerts=false
XLFile=Folder & Agenci & "- Wk-" & yer & "-" & week & ".xls"
XLDoc.SaveAs XLFile
XLApp.Quit
next
next
ActiveDocument.GetApplication.Sleep 30000
if PC2>0 then
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Weekly Report- " & Agenci & "- Wk-" & yer & "-" & week
objMessage.From = """DocAdmin"" <DocControlAudit.Report@csavgroup.com>"
objMessage.To = mail
objMessage.CC = maill
objMessage.BCC="DocControlAudit.Report@csavgroup.com,ajay.verma@csavgroup.com"
objMessage.TextBody = "Dear All" & vbCRLF & vbCRLF & "Please find attached your Agencies Open Pending Disrepancies Report showing Open Pending Discrepancies - Aging Wise/CreationWk Wise/Error Wise." & vbCRLF & "In second attachment you will find BLs still pending for clarification/rectification from Agency end. We need clarification/rectification on discrepancies within same week of submission of Weekly Report" & vbCRLF & vbCRLF & "We have added an additional column in this report to show the 'Current Status' with below 3 options:" & vbCRLF & "1- Agency Review Pending. -- If Doc Team has already replied after Agencies comments." & vbCRLF & "2- Doc Team Review Pending-- If answer received from agency and Doc team has not worked on it yet." & vbCRLF & "3. Blank Field-- No answer received from Agency so far." & vbCRLF & vbCRLF & vbCRLF & "Please try to close all the cases in attached file to improve the performance of your agency" & vbCRLF & vbCRLF & vbCRLF & "Best Regards" & vbCRLF & vbCRLF & "Documentation Administration Control" & vbCRLF & "CSAV Group (INDIA) Pvt Ltd" & vbCRLF & "Phone - +91-124-3068490 / 3068084" & vbCRLF & "Email- DocControlAudit.Report@csavgroup.com" & vbCRLF & vbCRLF
objMessage.AddAttachment reportFile
objMessage.AddAttachment XLFile
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.146.6"
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
objMessage.Send
end if
next
end sub
