- Katılım
- 3 Ekim 2011
- Mesajlar
- 63
- Excel Vers. ve Dili
- 2010
Arkadaşlar aşağıdaki kodlar hotmail adresinden mail göndermeye çalışıyorum ancak; Toplama dizininin yolu gerekli ancak belirtilmemiş (Run time error '214720958' (80040222) hatasını alıyorum.
Kod:
Dim wb As Workbook
Dim sh As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Sub HotMail_Eposta()
'ActiveWorkbook.Save
Set wb = ActiveWorkbook
Set sh = ActiveSheet
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "Gönderilen Excel Dosyasında kodlamalar yer almayacaktır.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("USERPROFILE") & "\Desktop\"
TempFileName = sh.Range("A9") & Chr(45) & Format(Now, "dd-mmmm-yyyy")
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "abcd@hotmail.com.tr"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "1234567891010"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = sh.Range("U2").Value
.CC = ""
.BCC = ""
.From = """ABCD Firması"" <abcd@hotmail.com.tr>"
.Subject = WorksheetFunction.Proper(sh.Range("A9"))
.TextBody = sh.Range("A9") & Chr(45) & Format(Now, "dd-mmmm-yyyy")
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Quit
End Sub
