Avatar billede sdh Mester
13. december 2012 - 17:09 Der er 3 kommentarer og
1 løsning

Mail ny fil med 2 ark fra samme gl. fil

Hej

Jeg har tidligere benyttet mig af Ron de Bruins hjemmeside når jeg har haft brug for nogle e mail markroer.
Jeg har nu den udfordring at jeg skal lave noget vba der kan sende 2 ark - fra samme fil udfra kriterier fra det ene ark.
Det ene ark er dynamisk - dvs. hvis arket har en mailadr. i celle a1 så skal det sendes. I samme fil har jeg et andet ark (Kunder)(fast)som jeg gerne vil have med hver gang der mailes.

Mit udgangspunkt er nedenstående VBA kode fra Ron de bruin der dog kun medtage det ark hvor der er angivet en mailadr.
 

Sub Mail_Every_Worksheet()
'Working in 2000-2010
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2010
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

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

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = "Sheet " & sh.Name & " of " _
                        & ThisWorkbook.Name & " " _
                        & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)
            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, _
                        FileFormat:=FileFormatNum
                On Error Resume Next
                With OutMail
                    .To = sh.Range("A1").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the Subject line"
                    .Body = "Hi there"
                    .Attachments.Add wb.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
            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr
        End If
    Next sh

    Set OutApp = Nothing

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

Håber at hører fra jer.
Avatar billede oleelo Nybegynder
14. december 2012 - 11:37 #1
Hej
Prøv at indsætte denne linje efter:Set wb = ActiveWorkbook
                     
ThisWorkbook.Sheets("Kunder").Copy After:=Sheets(1)

mvh oleelo
Avatar billede sdh Mester
14. december 2012 - 12:32 #2
Super - det var lige den sætning der skulle til for at det virker. Mange tak oleelo.
Smider du et svar så jeg kan komme af med nogle points:-)

Du må også meget gerne se på mit andet spørgsmål: http://www.eksperten.dk/spm/973682
hvis du har mod på lidt flere points:-)
Avatar billede oleelo Nybegynder
14. december 2012 - 14:03 #3
Hej
godt, her er et svar
mht hyperlinks, kan du ikke bare indsætte en formel i ark 2 celle c1 =Ark1!C1, eller må værdien kun være synlig hvis ????
mvh oleelo
Avatar billede sdh Mester
14. december 2012 - 14:46 #4
Vedr. Hyperlinks:
Problemet er at der flere hyperlinks i kolonne C ark1 - c2, c3 c4 etc. Alle går til ark2 celle c1. Derfor kunne det være smart hvis hyperlinksværdien kommer automatisk med over  til ark2 celle 1 når hyperlinket arktiveres. Arket (ark2) er et query - ark der automatisk opdateres når værdien i celle c1 ændres.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester