PDA

View Full Version : Solved: Server moved, macro failed



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.

AZIQN
03-30-2009, 02:11 PM
Hi Meatball, I'm no expert on vba like some of these people but it seems to me that the only thing in the code that may be affected by a server would be the temporary file path that is assigned to the file.

Ensure that this file path location is accessible:

TempFilePath = Environ$("temp") & "\"


If its not, assign the file a new TempFilePath that is easily accessed by the workstation.
Hope that helps...

Meatball
03-31-2009, 06:05 AM
AZIQN,
Thanks for the suggestion but when I tried to change the file path to my C; drive but I get an error at this line

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum

Error reads--Run time error "1004":
Microsoft Office Excel cannot access the file "C;\Documents and Settings\temp'. And then it list's a few reasons that may cause the problem.
When the server was moved, we had a serious slow down in connection speed. The run time error makes me think that the slow down is part of the problem. I will see about fixing that and then see what happens with the maro.

Kenneth Hobs
03-31-2009, 06:33 AM
I doubt that C;\Documents and Settings\temp exists. For one thing, your semicolon should be a colon. In Explorer, create a Temp folder in C: if it does not exist such as C:\Temp. Then use that.

To show your Temp evironment path in Explorer, in the Immediate window paste:
shell "explorer " & environ("temp"),vbNormalFocus

Prior to your SaveAs you could do this in your code, play it, and then view the value in the Immediate window:
debug.print TempFilePath & TempFileName & FileExtStr

Meatball
03-31-2009, 06:53 AM
Thanks Kenneth,
I have gotten past the error message now. The immediate window showed the files being sent to the temp folder. I did make a folder by that name so the saving of the files seems to be fixed. But, I am back to the original problem, I get the warning window saying Excel is trying to send a message and I click on allow, but no message actually gets sent and the temp folder is empty as I would expect. I do use Outlook as my mail handler.

Kenneth Hobs
03-31-2009, 07:33 AM
SendMail may not be your best route. If you do use it, try something simple first.

I would recommend trying CDO. http://www.vbaexpress.com/forum/showthread.php?t=22439

Meatball
03-31-2009, 08:50 AM
Kenneth,
Checked the link you posted, sorry but that was way over my head. I just did some testing and as near as I can tell the mail function works as long as there is only 1 recipient. All tests with 2 recipients have failed. Is there possibly a way to make a loop and after mailing to the address in A1 go back and send another to an address in B1?

Kenneth Hobs
03-31-2009, 09:07 AM
In your code, you are mailing to each A1 in each sheet already. Not sure where the B1 comes from.

Are your email addresses separated by commas? If that works, we can easily parse cells to create such if needed.

See this site for more outlook mailing examples. http://www.rondebruin.nl/sendmail.htm

Meatball
03-31-2009, 09:26 AM
Yes, before the server was moved the mail program worked having 2 recipients in A1. Now it only works when A1 has 1 recipient. I tried several ways to show both, seperated by comma, by semicolon, no space after each. It makes no sense at all to me but thats where I stand at the moment. Since each sheet does need to go to 2 people it seemed to me that a loop with the 2nd recipient in B1 would work at least, even if not the most elgant of fixes.

Meatball
03-31-2009, 09:56 AM
My last reply was before checking you link. It appears that the problem is fixed. i used this part from the link;
Send to all E-mail addresses in a range.

Dim MyArr As Variant
MyArr = ThisWorkbook.Sheets("Sheet1").Range("A1:A20")
.SendMail MyArr, "This is the Subject line"

And I am about to bust because I put the parts in the correct places the FIRST time. I Thought I would need help to incorporate the extra code. Thank you so much Kenneth, I really appreciate your help on this and I will mark this solved.