Beste,
Ik zit met onderstaand probleem.
Als ik deze macro onder windows 7 draai met excel 2007 werkt hij goed en verstuur ik direct tig keer een mailtje.
Ik vul mijn eigen mailadres in, in mijn excel file in de juiste kolom en cel. de locatie: F:\Documenten \naambestand.xlsm staat achter iedereen zijn naam en wordt als bijlage meegestuurd.
Als ik deze macro start onder windows 8 met excel 2007 komt de de rode regel iedere keer in beeld.
Kent windows 8 deze regel niet of zijn het instellingen die verkeerd staan. Ik ben al volop aan het zoeken naar verschillen maar zie geen instellingen die anders staan.
Outlook staat op beide computers als standaard email programma.
De macro komt van onze goede vriend Ron de Bruin zijn helpdesk site
PS: ik heb mijn tekst die ik in mijn mail gebruik aangepast naar de tekst "tekst" maar dat is voor de uitleg niet belangrijk.
'Met deze macro wordt het invulblad op locatie: F:\Documenten \Lentefeesten\Lentefeesten final\invulblad.xlsm
'verzonden naar de deelnemers die een mailadres hebben ingevuld
'Option Explicit
Sub Send_Files()
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("Deelnemers")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("J").Cells.SpecialCells(xlCellTypeConstants)
'Hier zie je waar je bestand om te versturen staat: in kolom AE ofwel kolom nr: 31
Set rng = sh.Cells(cell.Row, 1).Range("AE1:AF1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "TEKST"
.Body = "Beste " & cell.Offset(0, -5).Value & "," & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst" & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"met vriendelijke groet," & vbNewLine & vbNewLine & _
"tekst"
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 Send bij direct verzenden of .Display bij eerst inzien van je te versturen bestand
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Ik zit met onderstaand probleem.
Als ik deze macro onder windows 7 draai met excel 2007 werkt hij goed en verstuur ik direct tig keer een mailtje.
Ik vul mijn eigen mailadres in, in mijn excel file in de juiste kolom en cel. de locatie: F:\Documenten \naambestand.xlsm staat achter iedereen zijn naam en wordt als bijlage meegestuurd.
Als ik deze macro start onder windows 8 met excel 2007 komt de de rode regel iedere keer in beeld.
Kent windows 8 deze regel niet of zijn het instellingen die verkeerd staan. Ik ben al volop aan het zoeken naar verschillen maar zie geen instellingen die anders staan.
Outlook staat op beide computers als standaard email programma.
De macro komt van onze goede vriend Ron de Bruin zijn helpdesk site
PS: ik heb mijn tekst die ik in mijn mail gebruik aangepast naar de tekst "tekst" maar dat is voor de uitleg niet belangrijk.
'Met deze macro wordt het invulblad op locatie: F:\Documenten \Lentefeesten\Lentefeesten final\invulblad.xlsm
'verzonden naar de deelnemers die een mailadres hebben ingevuld
'Option Explicit
Sub Send_Files()
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("Deelnemers")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("J").Cells.SpecialCells(xlCellTypeConstants)
'Hier zie je waar je bestand om te versturen staat: in kolom AE ofwel kolom nr: 31
Set rng = sh.Cells(cell.Row, 1).Range("AE1:AF1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "TEKST"
.Body = "Beste " & cell.Offset(0, -5).Value & "," & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"tekst" & vbNewLine & _
"tekst." & vbNewLine & _
"tekst." & vbNewLine & vbNewLine & _
"met vriendelijke groet," & vbNewLine & vbNewLine & _
"tekst"
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 Send bij direct verzenden of .Display bij eerst inzien van je te versturen bestand
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
