VBA error issue

[Leske]

Hi i got this code from a previous project.

It is to send an excel sheet to a person.

in my .to i put a value "B2" this should be normally an email address or something that in outlook converts to an email address.
But in some cases it is not a valid email adress and VBA just handle it if there is no problem. The only thing is that it don't send anything.
What i want if it has no valid address that it change my .to by my email address so i can tackle those items myself

but don't know how to adapt the code also if there is code that is not necessary anymore please let me know.

Any help with this issue would be appreciated.

Leske

[a1].Select
    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 K As Long
      Dim OutApp As Object
    Dim OutMail As Object
    Dim COUNT As Long
    COUNT = 1
Dim NewWB As Workbook
    
    TempFilePath = Environ$("temp") & "\"
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2013
        FileExtStr = ".xlsx"
        ': FileFormatNum = 51
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
                       
    End With
    
     Set OutApp = CreateObject("Outlook.Application")


   
    For Each sh In ActiveWorkbook.Worksheets
      If sh.Name <> "Sheet1" And sh.Name <> "RP16CLNT50" Then
   
            sh.Copy
            Set wb = ActiveWorkbook
         '   TempFileName = "Sheet " & sh.Name & " of " _
         '                & ThisWorkbook.Name & " " _
          '               & Format(Now, "dd-mmm-yy h-mm-ss")
            
         TempFileName = sh.Name & _
                         " " _
                         & Format(Now, "dd-mmm-yy")
           Set OutMail = OutApp.CreateItem(0)


 
            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr
                ', _                        FileFormat:=FileFormatNum
                
          Set NewWB = wb
          
                On Error Resume Next
                For K = 1 To 1
                    With OutMail
                    .SentOnBehalfOfName = "...."
                   [COLOR=#ff0000] .to = sh.Range("b2").Value[/COLOR]
                    .Subject = "a"
                    .htmlbody = "Hello "
                    .Attachments.Add NewWB.FullName
         [COLOR=#ff0000]           .send[/COLOR]
                  End With
                    If Err.Number = 0 Then Exit For
                Next K
                On Error GoTo 0
                .Close SaveChanges:=False
            End With
            'Delete the file you have send
            Kill TempFilePath & TempFileName & FileExtStr
            COUNT = COUNT + 1
        End If
      ' Else
       'End If
    Next sh
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With



End Sub

 

[ranman256]

'test for valid targets, else assign you you

sTo =  trim(sh.Range("b2").Value)

select case true
  case instr(sTo,".com")>0
  case instr(sTo,".net")>0
  case instr(sTo,".edu")>0
  case instr(sTo,".gov")>0

  case else    'bad TO, set to mine
    sTo = "me@myCo.com"
end select

.To = sTO

 

[Leske]

the thing is that the value in B2 is a ID-digit of 8 numbers and when we put those in outlook it will change it to that persons email address but in some cases the person is not longer active.
So outlook doesn't recognize it and i get this: i(f i don't use on error resume next)

Check Names
Microsoft Outlook does not recognize "40277082". on the bottom right i can then take Cancel.

So at that moment i would like that he takes Cancel and replace the .to 40277082 to another email address.

I guess i can't use on error resume next and afterwards i need to adapt the .to and retry to send.