Meatball
03-30-2009, 06:34 AM
Hello all,
I have the following code which was working fine until the server that was being used was moved from on premises to offsite. The e-mailing part of the code seems to function, I get the warning that a remote program is trying to send mail, but even when "yes" send the mail is entered there is no actual message sent. The e-mail part of the code came from..not Pearson but the other one who makes code and puts it out for use, I think his name start with R.
Anybody know where to get the correct server info needed and/or what needs to be changed in the code?
Sub SortForZeroFirst()
'
' SortForZeroFirst Macro
' Macro recorded 3/9/2009 by David D
'
'
For i = 3 To Sheets.Count
With Sheets(i)
rw = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A5:J" & rw).Sort Key1:=.Range("J5"), Order1:=xlAscending, Key2:=.Range("C5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
End With
Next
Call Mail_ActiveSheet
End Sub
Sub Mail_ActiveSheet()
'Working in 97-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each sh In ThisWorkbook.Worksheets
If sh.Range("A1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy")
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail sh.Range("A1").Value, _
"Weekly customer update"
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Thanks in advance for the help.
I have the following code which was working fine until the server that was being used was moved from on premises to offsite. The e-mailing part of the code seems to function, I get the warning that a remote program is trying to send mail, but even when "yes" send the mail is entered there is no actual message sent. The e-mail part of the code came from..not Pearson but the other one who makes code and puts it out for use, I think his name start with R.
Anybody know where to get the correct server info needed and/or what needs to be changed in the code?
Sub SortForZeroFirst()
'
' SortForZeroFirst Macro
' Macro recorded 3/9/2009 by David D
'
'
For i = 3 To Sheets.Count
With Sheets(i)
rw = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A5:J" & rw).Sort Key1:=.Range("J5"), Order1:=xlAscending, Key2:=.Range("C5") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
End With
Next
Call Mail_ActiveSheet
End Sub
Sub Mail_ActiveSheet()
'Working in 97-2007
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each sh In ThisWorkbook.Worksheets
If sh.Range("A1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy")
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
.SendMail sh.Range("A1").Value, _
"Weekly customer update"
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Thanks in advance for the help.