Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

(excel) slanje dokumenata e-mailom (Outlook 2010)

[es] :: Office :: Excel :: (excel) slanje dokumenata e-mailom (Outlook 2010)

Strane: 1 2

[ Pregleda: 15578 | Odgovora: 28 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon (excel) slanje dokumenata e-mailom (Outlook 2010)13.05.2011. u 20:02 - pre 157 meseci
molim vas pomoć

pokušala sam sama ali nisam uspjela napisati makro naredbu za slanje dokumenata e-mailom iz fajla u excelu na određeni datum (npr.14.5.2011.)

Napravila sam radnu knjigu u kojoj se u koloni "A" nalazi naziv radne knjige koju želim poslati (npr Book1.xlsx, a u koloni "B" se nalazi e-mail adresa na koju šaljem tu radnu knjigu (npr.marko.marković@dora.hr) subjekt je isti za sve (npr. čokolada). Svi dokumenti za slanje nalaze se na adresi "C:\Maja\ .xls

(sada šaljem svaki e-mail pojedinačno (ima ih oko 200) koristim adresu marko.marković@dora.hr?subject=čokolada na kojoj je link i odmah mi je upisivan subjekt) ali je ovo strašno naporno i ubija stoga vas molim pomoć

Srdačan pozdrav
 
Odgovor na temu

neptuncokg
Predrag M
racunovodja
Kragujevac

Član broj: 230353
Poruke: 326
*.dynamic.isp.telekom.rs.



+9 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)13.05.2011. u 23:54 - pre 157 meseci
" ali je ovo strašno naporno i ubija stoga vas molim pomoć "...
A što ne pošaljes primer, toga sto je strašno ? Ova tema je jako interesantna, svako ima svoje "prohteve" kad je reč o slanju e-maila iz excela.
Pozdrav
 
Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
*.wimax.verat.net.

Sajt: www.gowi.rs


+109 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)14.05.2011. u 08:23 - pre 157 meseci
Pogledaj http://www.elitesecurity.org/t414835-0#2740260
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)14.05.2011. u 08:54 - pre 157 meseci
Dosadno je jer se ponavlja
Ovako to radim klik na adresu otvara se e-mail uvučem dokument pišem tekst primatelju
"U prilogu vam šaljem specifikaciju.
pozdrav,"

i tako 200 puta.

možda još pojašnjenje u fajlu "C:\Maja\ se nalaze dokumenti (oko 200 jedan od njih je i Book1.xlsx) koje moram poslati na adrese koje se nalaze u "C:\Adrese\E-mail adrese.xlsx.

Osim toga trebala bi biti i nekakva kontrola koja će mi na kraju reći da su poslani svi dokumenti ili ako nisu koji su to (razlog zašto nisu poslani može biti da dokumenat nema adresu)

nadam se da sam dobro objasnila



Prikačeni fajlovi
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)14.05.2011. u 10:24 - pre 157 meseci


hvala, već sam pokušala prilagoditi jer ovo je direktno slanje iz dokumenta, a ja trebam pripremljeni dokumenat kojeg sam pripremila prije, poslati u određeno vrijeme, recimo u ponedjeljak, svih 200 dokumenata poslati svaki na određenu adresu kao što je u prilogu
 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)14.05.2011. u 19:41 - pre 157 meseci
Citat:
Sudarica: ja trebam pripremljeni dokumenat kojeg sam pripremila prije, poslati u određeno vrijeme
Koliko sam shvatio ti imaš 200 *.XLS files
Želiš određene files kao attach poslati na određenu e-mail adresu, i to u jednom koraku

Nekada davno sam gledao takvu mogućnost ali iz Outlooka pa sam se sjetio VBA makronaredbe koju je napisao rondebruin
Ovaj Macro koristi se u Workbook
U Sheet1 upišeš sve podatke koji su potrebni
Ime-e-mail-path to filee

Pokretanjem Macroa automatski ti se u Outlooku kreiraju e-mail poruke sa prikačenim attachmentima
(postoji problem, ako trebaš dodati više teksta kao poruku ali i to se da riješiti dodatnim izmjenama)

Međutim ne znam kako će reagirati tvoj ISP e-mail provider ako u jednom koraku pođeš slati 200 poruka.
Probao sam jednom poslati Mailmerge više e-mail poruka preko Outlooka (150 poruka) i bilo je problema pa sam morao 20 po 20 poruka slati jer je navodno moj ISP to smatrao spamom. No nisam siguran probaj.

Evo Macro koji ćeš vjerojatno morati doraditi ako ti odgovara (vidi file u prilogu ove poruke)
Code:
Sub Send_Files()
'Working in 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range, FileCell As Range, rng As Range

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

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Izvješće za Svibanj 2011"
                .Body = "Pozdrav " & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send 'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Prikačeni fajlovi
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)14.05.2011. u 21:06 - pre 157 meseci
Ne mogu sada isprobati, nešto sam si poremetila u Outlooku, moram pronaći što. Jedva čekam da to isprobam.

hvala ti

srdačan pozdrav
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)15.05.2011. u 09:40 - pre 157 meseci
Ivek radi probala sam na dva primatelja super.

Dali postoji mogućnost da se prepišu svi naslovi dokumenata koji su pripremljeni za slanje u fajlu c:\Temp , Onda bi tom popisu pomoću funkcije CONCATENATE pripojila put, a pretraživačem iz dokumenta E-mail adrese.xlsx. upisala adresu i na taj način popunila potrebne stupce SendMultipleWorkbooks.xls i bila sigurna da mi je sve točno prije nego kliknem na pošalji.


Od tog popisa ću onda lako moći napraviti više SendMultipleWorkbooks.xls ako bude problema kod slanja.






 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)15.05.2011. u 12:03 - pre 157 meseci
Citat:
Sudarica: Dali postoji mogućnost da se prepišu svi naslovi dokumenata koji su pripremljeni za slanje u fajlu c:\Temp
Google čuda čini

Ovaj Macro služi za pronalaženje naziva svih files u folderu C:\Temp
Pokretanjem macroa kreira se novi Sheet i u njemu popis
Code:
Sub ListAllFile()
'radi u Excel 2007
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add
    
    'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\Temp\")
    ws.Cells(1, 1).Value = "Files pronađeni u " & objFolder.Name & " su:"
    
    'Loop through the Files collection
    For Each objFile In objFolder.Files
        ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
    Next
    
    'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

btw: proguglaj ima još makronaredbi koje rade isti ili sličan posao.
Prikačeni fajlovi
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)15.05.2011. u 16:06 - pre 157 meseci
Ivek ti si sunčeko hvala ti idem testirati

Hvala
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)15.05.2011. u 16:51 - pre 157 meseci
Prvi test

prepisala sam datoteke (prepisane su u kolonu A) sada sam u kolonu B dodala put (C:\temp) pomoću CONCATENATE=C:\temp;"\";book1 tako sam dobila FileNama1. Sada ću pomoću Vlookup pronaći odgovarajuće adrese. Sve pretvoriti u vrijednosti ( paste Value) uljepiti u colonu adrese i dodati linkove i to je pretpostavljam to. Javiću se
 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)15.05.2011. u 18:22 - pre 157 meseci
Citat:
Sudarica: prepisala sam datoteke (prepisane su u kolonu A) sada sam u kolonu B dodala put (C:\temp) pomoću CONCATENATE=C:\temp;"\";book1 tako sam dobila FileNama1.
Ajde dobro ako te to zadovoljava

Pitam se zašto hoćeš dobiti samo imena svih files pa kombinirati sa funkcijom Concatenate kada možeš odmah dobiti cijelu path stazu za sve files u folderu.

Ovaj macro ispod upravo to radi (vidi attach poruke)
(ako ga kopiraš trebaš u dotičnoj Workbook u VBE aktivirati Tools => References => i uključiti Microsoft Scripting Runtime

Code:
Dim iRow

Sub ListPathNameFiles()
    iRow = 5
    Call ListMyFiles(Range("B1"), Range("B2"))
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        iCol = 1
        Cells(iRow, iCol).Value = myFile.Path
        iCol = iCol + 1
        Cells(iRow, iCol).Value = myFile.Name
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub
Prikačeni fajlovi
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)16.05.2011. u 16:59 - pre 157 meseci
Odlično radi super svaka čast

imam još jedan problem a vidjela sam malo po forumima da je to problem inače.

Kada šalješ e_mail iz Excela nemaš Digital Signature (potpis), znam da ćeš reći da Ron de Bruin ima rješenje ali meni smeta GetBoiler (malo mi fali engleski)
 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Slanje Workbook i signature ili potpisa u Excelu preko Outlook e-maila18.05.2011. u 10:52 - pre 157 meseci
Citat:
Sudarica: imam još jedan problem a vidjela sam malo po forumima da je to problem inače.

Kada šalješ e_mail iz Excela nemaš Digital Signature (potpis), znam da ćeš reći da Ron de Bruin ima rješenje ali meni smeta GetBoiler (malo mi fali engleski)
I nije to problem kada šalješ jedan snimljeni-ažurirani Workbook iz Excela putem e-maila, ali ne znam kako bi to bilo na tvom primjeru i tvojim zahtjevima (možda bi mogao netko tko aktivno programira u VBA?)

Kao što si rekla Ron de Bruin ima rješenje za to (slanje Workbook na više e-mail adresa uz prikačeni Signature).
Što se tiče GetBoiler jednostavno ga kopiraj u neki module tvoje radne knjige
Code:
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function


Drugi Macro zavisi šalješ li HTML ili PLAIN predložak. Ovo je primjer za Html predložak
Code:
Sub Mail_Outlook_With_Signature_Html()
' Ne zaboravi kopirati funkciju GetBoiler u module.
' radi u Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

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

    strbody = "<H2><B>Poštovani prijatelju</B></H2>" & _
              "Šaljem ti izvešće za 2011<br>" & _
              "Javi mi ako ima problema<br>" & _
              "<A HREF=""http://www.ic.ims.hr/index.html"">posjeti moju web stranicu</A>" & _
              "<br><br><B>pozdravljam te i ugodno popodne</B>"

    'Upotrijebi drugi SigString ako koristiš Vista ili Win 7 a prvi ignoriraj komentarima
    'ovo je prvi SigString
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\TVOJ-SIGNATURE.htm"
    'ovo je drugi SigString
    'SigString = "C:\Users\" & Environ("username") & _
     "\AppData\Roaming\Microsoft\Signatures\TVOJ-SIGNATURE.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next
    With OutMail
        .To = "[email protected]"
        .CC = "[email protected]"
        .BCC = ""
        .Subject = "Šaljem izvješće za 2011"
        .HTMLBody = strbody & "<br><br>" & Signature
        'Možeš dodati attachment ako želiš
        '.Attachments.Add ("C:\test.txt")
        .Send   'Send je za automatsko slanje a .Display za pripremu slanja i mogućnost editiranja
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Potrebno je da pronađeš naziv svog Signature na određenoj putanji i zamjeniš naziv "TVOJ-SIGNATURE.htm"
Ovo uredno funkcionira kada šaljem jedan Workbook na više e-mail adresa koje definiram u samoj makronaredbi.
Ne znam kako bi to ukomponirala u svoj problem, no možda bi se i moglo ?
btw: vidi attach i usput posjeti http://www.rondebruin.nl/mail/folder3/signature.htm
Prikačeni fajlovi
 
Odgovor na temu

Sudarica

Član broj: 119175
Poruke: 209
*.adsl.net.t-com.hr.



Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)18.05.2011. u 21:39 - pre 157 meseci
Hvala Ivek

sutra ću dodati u svoju naredbu

hvala ti puno

srdačan pozdrav

 
Odgovor na temu

ramzesIV

Član broj: 263681
Poruke: 149
*.univie.teleweb.at.



+6 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)20.05.2011. u 08:47 - pre 157 meseci
pozdrav!

ovi makroi su stvarno super, ja imam jedno slicno pitanje:

postoji li mogucnost da se posalje iz outlook-a uz pomoc makroa reply na jedan mail uz attachment jednog excel fajla.

dobijem mail, ja u excelu uradim to sto treba i onda odgovorim na taj mail sa tim excelom kao attach?


ako ne onda da iz excela nekako posaljem aktivni excel sheet kao attach toj osobi?
 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)20.05.2011. u 14:04 - pre 157 meseci
Citat:
ramzesIV: ako ne onda da iz excela nekako posaljem aktivni excel sheet kao attach toj osobi?
Da bi poslao aktivni Sheet iz Excela na e-mail iskoristi ovu makronaredbu, koju kopiraj u Module u VBE

- Otvori Outlook
- Pokreni Excel, ažuriraj Sheet i snimi Workbook pod nazivom koji je adekvatan elementima Sheeta koji želiš poslati
- Pozicioniran si na Sheetu koji želiš poslati, pokreni Macro (ALT+F8)
- Otvara ti se nova poruka u Outlooku
- Upiši e-mail adresu (koju moraš znati) i editiraj body text
- Pošalji

btw: editiraj dijelove da bi dobio ispravan Subject i naziv file koji šalješ
Code:
Option Explicit

Sub Mail_ActiveSheet()
'Working in 97-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 I As Long

    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 97-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 a 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 = "Šaljem izvješće za " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail "", _
                      "Ovo je izvješće za 2011"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

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

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


Prikačeni fajlovi
 
Odgovor na temu

ramzesIV

Član broj: 263681
Poruke: 149
*.univie.teleweb.at.



+6 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)20.05.2011. u 14:29 - pre 157 meseci
Ivek, fenomenalno,

jos 3 pitanja:

1. da li mogu da saljem kopiju tog excela,
2. posto taj excel saljem samo na 4 razlicite osobe. ili jednoj ili drugoj ili 3 ili cetvrtoj, da li moze uz ovaj makro da se stavi i automatski upis maila. npr kad kliknem na E30 da salje jednoj, E31 drugoj, ...
3. posto mi je aktivan drugi excel. treba da napisem makro koji ce aktivirati excel koji saljem, pa onda da ga stavi kao attach, kopiju, pa da automatski unese mail?

ja sve imam snimljeno u excelu koji je snimljen kao Sim. i tu sam snimila tvoj makro.

a saljem excel "simulacija" kao attach. ono sto ja hocu je kliknem u excelu Sim makro i on salje simulaciju na mail.

ali i ovaj makro je super.
 
Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898



+66 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)20.05.2011. u 20:30 - pre 157 meseci
Citat:
ramzesIV: 1. da li mogu da saljem kopiju tog excela,
Da bi poslala aktivni Sheet na određenu e-mail adresu koju želiš imati u nekoj ćeliji iskoristi ovaj Macro ispod (ako je ćelija A1 zauzeta koristi drugu ćeliju)

Šalje aktivni Sheet (kao attach) na e-mail adresu upisanu u ćeliji A1 dotičnog Sheeta. Znači možeš imati više Sheets ali u A1 različite e-mail adrese. Kada se pozicioniraš na određeni sheeet i pokreneš Macro on će poslati na e-mail adresu iz A1 na trenutnom sheetu sa kojega si pokrenula macro.
Code:

Option Explicit

Sub MailAddressActiveSheet()
'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
    Dim ws As Worksheet

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

    Set Sourcewb = ActiveWorkbook

    'kopira sheet u novu 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 97-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 a 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 = "Izjvjesce2011 " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

For Each ws In ActiveWorkbook.Worksheets
        If ws.Range("A1").Value Like "?*@?*.?*" Then
        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 = ws.Range("A1").Value
            '.CC = ""
            '.BCC = ""
            .Subject = "Izvješće za 2011"
            .Body = "Pozdrav, šaljem vam izvješće za mjesec svibanj 2011"
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send 'ili upotrijebi .Display ako zelis dodatno editirati email poruku
        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 If
    Next ws

End Sub

Ovaj macro automatski šalje aktivni Sheet (smješta ga u Outbox - MS Outlooka). Ako želiš dodatno imati mogućnost editiranja body teksta poruke tada umjesto .Send koristi naredbu .Display.
Za više detalja i mogućnosti pogledaj kako možeš poslati aktivni radni list na više e-mail adresa koje definiraš u samoj makronaredbi
 
Odgovor na temu

neptuncokg
Predrag M
racunovodja
Kragujevac

Član broj: 230353
Poruke: 326
212.200.65.*



+9 Profil

icon Re: (excel) slanje dokumenata e-mailom (Outlook 2010)21.05.2011. u 12:46 - pre 157 meseci
Posto je i meni ova tema jako interesantna, evo mog skromnog doprinosa. Dokumenat koji prilazem sluzi za:
1 - Slanje jednog, ili vise sheetova na izbranu adresu. Izbor sheetova se vrsi "dvoklikom" na padajucoj listi na formi, a slanje - klikom na button "POSALJI SHEET"
2 - Slanje celog dokumenta na izbranu adresu - klikom na button "POSALJI BOOK"
3 - Direktnu prepisku ("catovanje") - izborom sheeta "TEXT"

Ja sam to pravio za svoje potrebe, i kod mene lepo radi - pod Outlook Express-om. Medjutim, nisam uspeo da doradim program tako da pored izbora jednog, ili vise, sheetova za slanje, sve to saljem i na - vise adresa. Pozdrav
Prikačeni fajlovi
 
Odgovor na temu

[es] :: Office :: Excel :: (excel) slanje dokumenata e-mailom (Outlook 2010)

Strane: 1 2

[ Pregleda: 15578 | Odgovora: 28 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.