lege cellen negeren

  • Onderwerp starter Onderwerp starter Roma
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

Roma

Gebruiker
Lid geworden
7 sep 2013
Berichten
515
Beste VBA kenners,

ik heb een code maar het probleem is dat hij de lege cellen moet negeren. Ik heb van alles geprobeerd en opgezocht maar ik kom er niet uit.
Het gaat om:Range("V2") en Range("B3") als deze leeg zijn dan overslaan
Wie kan mij helpen.

Dit is de volledige code:

Code:
Sub OPTPDF()
'Code gekregen van Helpmij (Rudi)
   sn = Sheets("Vakkaart").Range("B10").CurrentRegion
    For d = 2 To UBound(sn)
        If sn(d, 1) = "E-mail" Then tomail = tomail & sn(d, 2) & ";"
           Next
           
    For i = 1 To 35
    Application.ScreenUpdating = False
    'Range V2 staan de namen van de collega's
    'Range B3 staan de e-mail adressen
    
                 If InStr(1, tomail, Sheets("K" & i).Range("V2").Value, vbTextCompare) Then
            With Sheets("K" & i)
                Fname = .Range("V2").Value & ".pdf"
              
                eAddress = .Range("B3").Value
               ''MsgBox ThisWorkbook.Path
                ''MsgBox Fname
                .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Fname
                 End With
                 
          With CreateObject("Outlook.application").CreateItem(0)
                .To = eAddress
                .Subject = " maand"
                .Body = "Bijgaand: " _
                        & vbNewLine & "" _
                        & vbNewLine & ""
                .Attachments.Add ThisWorkbook.Path & "\" & Fname
      On Error Resume Next
                .Send
           If Err.Number <> 0 Then
              On Error GoTo 0
         End If
 End With
                
                Kill ThisWorkbook.Path & "\" & Fname
                Application.ScreenUpdating = True
               End If
              Next
      End Sub
 
Code:
With Sheets("K" & i)
[COLOR=#ff0000]  if .range("b3") <> vbnullstring and .range("v2") <> vbnullstring then[/COLOR]

    Fname = .Range("V2").Value & ".pdf"
              
                eAddress = .Range("B3").Value
               ''MsgBox ThisWorkbook.Path
                ''MsgBox Fname
                .ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Fname
                 End With
                 
          With CreateObject("Outlook.application").CreateItem(0)
                .To = eAddress
                .Subject = " maand"
                .Body = "Bijgaand: " _
                        & vbNewLine & "" _
                        & vbNewLine & ""
                .Attachments.Add ThisWorkbook.Path & "\" & Fname
      On Error Resume Next
                .Send
           If Err.Number <> 0 Then
              On Error GoTo 0
         End If
 End With
                
                Kill ThisWorkbook.Path & "\" & Fname
                Application.ScreenUpdating = True
               End If
              Next

[COLOR=#ff0000]end if[/COLOR]
 
Laatst bewerkt:
Beste Harry,
Bedankt voor je reactie.
Als ik maar 1 e-mail adres invoer dan krijg ik er wel 35 binnen.
hoe kan dat opgelost worden
 
Ik heb mijn vorig bericht aangepast.
 
Harry
Helaas ik krijg nu geen e-mails meer binnen
 
Vorig bericht opnieuw aangepast.
 
Laatst bewerkt:
Harry,
Mijn fout.
Het werkt super. Je bent een superman.
Bedankt
 
Ik had het al opnieuw aangepast.
Waarin moet ik het herstellen.
 
Harry,
Ik had een fout gemaakt. e-mail adres in verkeerde cel gezet.
Nu werkt het perfect. Zoals ik het graag wilde.
Nogmaals bedankt voor alles
 
Ik wil het forumbericht rechtzetten.
Met welke coderegel was dat?
 
Jij heb het helemaal goed gedaan
Ik had het e-mail adres in cel C3 in plaats van B3
Jouw code is uitstekend.
 
Dat weet ik, maar is geen antwoord op mijn vraag.
Of is dat te moeilijk?
Zo hebben zoekers op het forum er natuurlijk niets aan als er fouten staan.
 
In dit geval staan er geen fouten in de code #2. De zoekers op dit forum kunnen deze code prima gebruiken indien nodig.
Mijn fout maakte ik in eAddress = .Range("B3").Value (had in het bestand C3 gezet)
Ron
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan