VBA-macro za slanje e-maila

Za slanje e-maila iz VBA koristim makro koji sam uradio uz pomoc helpa i jedne teme na forumu (iz VB-6). Evo kako to izgleda
Dim objoutlook As Outlook.Application
Dim objmail As Outlook.MailItem
Set objoutlook = Outlook.Application
Set objmail = objoutlook.CreateItem(olMailItem)

With objmail
.To = "[email protected]"
.CC = "[email protected]"
.Subject = "arhiva2010"
.Body = "<>"
.Attachments.Add ("D:\ARHIVA\2010.arj")
.Send
End With

Set objoutlook = Nothing
Set objmail = Nothing

1. - Na forumu sam nasao misljenje (tema od pre par godina) da ova akcija ne moze da se odradi preko OutlookExpress-a, vec samo preko MS-Outlook-a. Zanima me da li je tu doslo do nekog napretka, jer vecina korisnika ne koristi Outlook.
2. - Problem koji meni pravi Outlook je "pitalica" pred samo slanje, koja "kvari" automatizaciju programa.
"...If this is unexpected it may be a virus and you should choose NO..." (Prilazem u upload-u). Na internetu postoje neka resenja da se ovo zaobidje, ali se odnose na VB6, C# i sl. Nisam uspeo da ih iskoristim u VBA. Ako je neko imao slican problem, pa ga resio, bio bih zahvalan na pomoci. Pozdrav

Na računaru imam neke kodove za slanje mejla. Vidi prilog.

Hvala na ogovoru. Ovaj poslednji kod dokazuje da moze da funkcionise slanje e-maila iz VBA, uz koriscenje OutlookExpress-a. Ja sam ga ubacio u moj program i - radi. Medjutim, ne polazi mi za rukom da ubacim Atach, a to mi je najvaznije u celoj prici. Probao sam da umetnem: "Atach ("D:\...\neki fajl.arj)", "Atachment (D:\...)",
"Atach.Add (D:\...)", "Atach = D:\...", ali nista od toga ne funkcionise. Email ode, ali bez Atacha, a sa .Add - pukne program. Ima li resenja ? Hvala i pozdrav

Kod iz fajla koji se nalazi u prilogu u mejl stavlja aktivan excel dokument. Ako ne uspeš pogledaću na poslu da li još imam programski kod kojeg sam pre 2-3 godine kreirao koji mejl sa prilogom šalje na unapred definisane mejl adrese.

Hvala unapred, zaista bi mi mnogo znacilo. Meni ne treba slanje aktivnog dokumenta, vec iskljucivo dokumenata.arj koji se nalaze u nekom folderu, prethodno spakovani.Pozdrav

Pošto sam menjao računar nisam sve podatke prebacio na novi pa tako ni kodove za slanje mejla.
Ipak, na net-u sam pronašao kod (za Outlook - vidi da li možeš da iskoristiš za Outlook Express; ja ga nemam pa ne mogu ni da testiram) za slanje nekog fajla:

Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
.Attachments.Add ("C:\Documents and Settings\Pera\Desktop\programiranje\Book1.zip")
.Display 'or use .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Hvala jos jedanput na saradnji. Ovakav cod za Outlook vec koristim, ali kao sto sam naveo, ne moze da se iskoristi za OutlookExpress. Jedino sto radi sa "Expressom" je makro iz tvog prvog posta, ali "ne poznaje" Attach, tj. ne moze da mu se prikaci fajl kao u Outlooku - .Attachment.Add. Ceo googl sam pretrazio i - nista. Pozdrav

Moze neko da mi ojasni kako se kod ovog macro-a aktivira deo gde se fajl koji se napravi, kopira celije samo samo kao vrednost (plava slova). Ja kad sklonim one apostrofe onda mi macro ne radi
Evo macroa:

Sub Mail_ActiveSheet()
'Working in 2000-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010, we exit the sub when your answer is
'NO in the security dialog that you only see when you copy
'an sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Potpis

saka

reseno

Potpis

saka

Pih!Škrtice
Mogao si napisati Kako si riješio radi drugih čitalaca teme