I te pliki muszę wysyłać do naszych darczyńców. I teraz nie chce za każdym razem zmieniać nazwy pliku z List Intencyjny 2 na List Intencyjny, tylko chce aby program skrypt po usunięciu przeze mnie pliku List Intencyjny, zmieniał automatycznie nazwę następnego z List Intencyjny 2 na List Intencyjny
Każdy ten list jest inny od razu mówię, zaadresowany do konkretnej osoby
Proszę wstawić mi do korespondencji seryjnej drugi załącznik który jest taki sam dla wszystkich do tego treść do meila która nie jest załącznikiem. Jeśli na znasz darmowy sposób na to w office 2013, to proszę napisz.
Sub emailmergewithattachments()
Dim Source As Document, Maillist As Document, TempDoc As Document
Dim Datarange As Range
Dim i As Long, j As Long
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As String, message As String, title As String, dirName As String, strName As String
Set Source = ActiveDocument
' Check if Outlook is running. If it is not, start Outlook
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
' Open the catalog mailmerge document
With Dialogs(wdDialogFileOpen)
.Show
End With
Set Maillist = ActiveDocument
' Show an input box asking the user for the subject to be inserted into the email messages
message = "Enter the subject to be used for each email message." ' Set prompt.
title = " Email Subject Input" ' Set title.
' Display message, title
mysubject = InputBox(message, title)
' Display message, title
message = "directory with for attachments np c:\folder name\"
dirName = InputBox(message, title)
message = "name of attachment np nazwa.pdf"
strName = InputBox(message, title)
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document,
' extracting the information to be included in each email.
MkDir "c:\tmp"
For j = 1 To Source.Sections.Count - 1
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = mysubject
.Body = Source.Sections(j).Range.Text
Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
Datarange.End = Datarange.End - 1
.To = Datarange
For i = 2 To Maillist.Tables(1).Columns.Count
Set Datarange = Maillist.Tables(1).Cell(j, i).Range
Datarange.End = Datarange.End - 1
If j = 2 Then
MkDir "c:\tmp\" & Datarange.Text
Name dirName & "\" & Datarange.Text As "C:\tmp\" & Datarange.Text & "\" & strName
.Attachments.Add Trim("C:\tmp\" & Datarange.Text & "\" & strName), olByValue, 1
Else
.Attachments.Add Trim(dirName & "\" & Datarange.Text), olByValue, 1
End If
Next i
.Send
End With
Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges
' Close Outlook if it was started by this macro.
If bStarted Then
oOutlookApp.Quit
End If
MsgBox Source.Sections.Count - 1 & " messages have been sent."
'Clean up
Set oOutlookApp = Nothing
End Sub
No i to makro wysyła email z danym załącznikiem do adresata przypisanego do danego załącznika, dodając treść którą przecież możesz dodać na sztywno (bo niczym się nie różni).
Moja modyfikacja to pobranie nazwy pliku który chcesz wysłać, w sensie tworzę folder tymczasowy (który celowo się nie usuwa, bo nie mam na czym przetestować kodu),
w tym folderze tworzę indywidualne foldery dla każdego z plików (plik pobierany z załącznika ma taką samą nazwę jaką ma plik wysyłany) no i kopiuje tam plik pod nazwą którą mu narzucisz (czyli wszystkie pliki bd miały taką samą nazwę - twoje wymaganie).
A potem dodaje ten załącznik tak jak by to robił program na którym się wzorowałem.
Reasumując masz jakąś listę (musisz przecież jakoś te pliki dobierać do adresata), jak byś się uparł i miał dane adresata w pdf to mógłbyś se tą listę z automatu też wygenerować, no i wg tej listy sam się ten twój spam wysyła Bez klikania, bez 3maili na minute
Tak międzyczasie znalazłem trzeba dodać referencje.
Ale niestety dalej makro nie działa, uruchamia się poprawnie wskazuje na plik z tabelą wordowską, pyta o nazwę tematu i pisze po chwili, że wysłano 0 meili
Bez klikania, bez 3maili na minute