Hej
Använder scriptet nedan för att plocka ut poster ur ett excel ark och skicka dom till en exklusiv mottagare, vilket funkar bra. Dock skulle jag vilja ha ett annat utformat (excel) på utskicket än det som man är hänvisade till i skriptet ( .HTMLBody = RangetoHTML(rng) ).


Hur löser man det ?



Sub Send_Row_Or_Rows_2()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim mailAddress As String

On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

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

'Set filter sheet, you can also use Sheets("MySheet")
Set Ash = ActiveSheet

'Set filter range and filter column (Column with E-mail addresses)
Set FilterRange = Ash.Range("A1:G" & Ash.Rows.Count)
FieldNum = 1 'Filter column = A because the filter range start in A

'Add a worksheet for the unique list and copy the unique list in A1
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True

'Count of the unique values + the header cell
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

'If there are unique values start the loop
If Rcount >= 2 Then
For Rnum = 2 To Rcount

'Filter the FilterRange on the FieldNum column
FilterRange.AutoFilter Field:=FieldNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value

'Look for the mail address in the MailInfo worksheet
mailAddress = ""
On Error Resume Next
mailAddress = Application.WorksheetFunction. _
VLookup(Cws.Cells(Rnum, 1).Value, _
Worksheets("Mailinfo").Range("A1:B" & _
Worksheets("Mailinfo").Rows.Count), 2, False)
On Error GoTo 0

If mailAddress <> "" Then
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.to = mailAddress
.Subject = "Test mail"
.HTMLBody = RangetoHTML(rng)
.Display 'Or use Send
End With
On Error GoTo 0

Set OutMail = Nothing
End If

'Close AutoFilter
Ash.AutoFilterMode = False

Next Rnum
End If

cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True

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

Hur menar du?

Mailet skickas såvitt jag kan förstå i html-format, där html-koden skapas av funktionen RangetoHTML() som rimligtvis finns definierad nånstans i ditt script. Där bör du kunna påverka hur mailet kommer se ut.

Frågan är fortfarande otydlig. Vill du att exceldokumentet ska skickas som en bilaga i mailet eller vad är målet?

Isf tror jag nåt sånt här bör funka:

outMail.Attachments.Add "C:\minexcelfil.xls"

Till att börja med vill jag tacka dig för ditt engagemang i frågan.

Scriptet ska tar ut poster på flik "ett" och maila dessa enligt anvisning på flik "Mailinfo", vilket funkar bra. Dock är man hänvisade till i scriptet att skicka innehållet i HTMLBody och det är det jag vill ersätta så att innehållet skickas som bilaga.

Vad jag inte förstår av ditt svar är hur jag i det här scripte ska ersätta " .HTMLBody = RangetoHTML(rng)" med outMail.Attachments.Add "C:\minexcelfil.xls" i och med att scriptet inte skapar någon fil som jag kan se (OBS nybörjare ).

mvh PÅ

Ah ok, i så fall *tror* jag att principen är att du vill spara ner ett excelark som innehåller exakt det du vill - d.v.s. flik ett - någonstans. Därefter kör du

outMail.Attachments.Add "C:\minexcelfil.xls"
outMail.HTMLBody = "<p>Här har du en excelfil!</p>" ' och/eller outMail.Body = "Här har du en excelfil!"