- Katılım
- 12 Mayıs 2009
- Mesajlar
- 174
- Excel Vers. ve Dili
- Office 2003
Merhaba,
Çalıştığım kurumda internete tek bir proxy adresi ile erişilebiliyor. Aşağıdaki e-mail yollama kodlarını kullanmaya çalıştığımda, haliyle başarı elde edemiyorum çünkü excel internete erişemiyor. Bu durumu aşabilmek için, e-mail yollama işlemi başlamadan evvel excel'in bağlantı ayarlarındakı proxy adresini nasıl değiştirebilirim?
Çalıştığım kurumda internete tek bir proxy adresi ile erişilebiliyor. Aşağıdaki e-mail yollama kodlarını kullanmaya çalıştığımda, haliyle başarı elde edemiyorum çünkü excel internete erişemiyor. Bu durumu aşabilmek için, e-mail yollama işlemi başlamadan evvel excel'in bağlantı ayarlarındakı proxy adresini nasıl değiştirebilirim?
Kod:
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
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") = "xxxxxxxxxxxx@gmail.com" 'sizin mailiniz
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxx" 'kendisifreniz
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "xxxxxxxxxxxx@gmail.com" 'giden adres
.CC = ""
.BCC = ""
.From = """Konu"" <xxxxxx@gmail.com>" 'giden adres
.Subject = "pc açıldı " & Format(Now, "dd-mm-yy- h-mm-ss")
.TextBody = Format(Now, "dd-mm-yy - h-mm-ss") & " Yedek alınmıştır."
.AddAttachment TempFilePath & TempFileName & FileExtStr
.send
End With
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
