Jagdev Singh
Active Member
Hi Experts
I have the below code which supposed to save the list of emails in a draft folder. It works fine, but the excel file gets hanged after saving 12-13 mails in my draft folder. Could you please let me know what I am doing wrong here.
Regards,
JD
I have the below code which supposed to save the list of emails in a draft folder. It works fine, but the excel file gets hanged after saving 12-13 mails in my draft folder. Could you please let me know what I am doing wrong here.
Code:
Sub Create_WCN_Statements()
Dim strFname As String
'Dim Statementdate As String
Application.DisplayAlerts = False
Workbooks("Macro.xlsm").Activate
Sheets("Email Database").Select
'Range("D2").Value = InputBox("Insert Date in MM/DD/YY Format for Statement, Email Body & Subject line")
'If Range("D2").Value = "" Then
'Statementdate = Range("D3").Text
'End If
Dim TheString As String, TheDate As Date
Dim Statementdate As String
Dim Emaildate As String
Range("D2").Select
Selection.ClearContents
Selection.NumberFormat = "[$-409]d-mmmmmm-yyyy;@"
Range("B5").Select
Selection.ClearContents
Selection.NumberFormat = "[$-409]mmmmmm yyyy;@"
TheString = Application.InputBox("Insert Date in DD/MM/YY Format for Statement, Email Body & Subject line")
If IsDate(TheString) Then
TheDate = DateValue(TheString)
Else
MsgBox "Invalid date"
Exit Sub
End If
Range("D2") = TheDate
Range("D2").Select
Selection.NumberFormat = "[$-409]d-mmmmmm-yyyy;@"
Statementdate = Range("D2").Text
Range("B5") = TheDate
Range("B5").Select
Selection.NumberFormat = "[$-409]mmmmmm yyyy;@"
Emaildate = Range("B5").Text
Sheets("Agent ID").Select
Dim lastrow As Long
With ThisWorkbook.ActiveSheet
R = .Range("A65536").End(xlUp).Row
For a = 2 To R
Sheets("WCN Raw Data").Select
ActiveSheet.Range("A:S").AutoFilter Field:=16, Criteria1:=.Cells(a, 1), Operator:=xlAnd
Workbooks.Open ("I:\WCN & WREP Statements Macro\Statement Templates\WCN Statement Template.xlsx")
Workbooks("Macro.xlsm").Activate
Sheets("WCN Raw Data").Select
lastrow = Sheets("WCN Raw Data").Cells(Rows.Count, 1).End(xlUp).Row
Range("A1").Select
Range("A1:S1" & lastrow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("WCN Statement Template.xlsx").Activate
Sheets("WCN_Statement").Select
Range("B12").Select
ActiveSheet.Paste
Range("B12").Select
Rows("12:12").Select
Selection.Delete Shift:=xlUp
Range("B12").Select
strFname = Range("R12").Text
FPath = "I:\WCN & WREP Statements Macro\Statements\WCN\"
strNomeFicheiro = Range("R12") & " - " & Range("Q12").Value
strNomeFicheiro = Replace(strNomeFicheiro, "/", " ")
For j = 1 To 31
strNomeFicheiro = Replace(strNomeFicheiro, Chr(j), "")
Next j
ActiveWorkbook.SaveAs Filename:=FPath & strNomeFicheiro & ".xlsx"
Application.Run "Macro.xlsm!Macro5"
Range("G2").Select
Range("G2").Value = "Account Detail as at - " & Statementdate
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Macro.xlsm").Activate
Sheets("WCN Raw Data").Select
ActiveSheet.AutoFilterMode = False
Range("A1").Select
Sheets("Agent ID").Select
Sheets("Email Database").Select
Range("B1").Select
ActiveCell.Formula = strFname
Range("B6").Select
ActiveCell.Formula = strNomeFicheiro
Application.Run "Macro.xlsm!Email_WCN"
Windows("Macro.xlsm").Activate
Sheets("Agent ID").Select
Next a
End With
Sheets("Email Database").Select
Range("D2").Select
Selection.ClearContents
Sheets("Agent ID").Select
Range("A1").Select
MsgBox "Done"
Application.DisplayAlerts = True
End Sub
JD