Outlook VBA for sending av filer på epost

[Zafar Iqbal]

Hei,

 

Jeg bruker vba koden nedenfor som fungerer utmerket. Men den sender også med de skjulte thumb.db filene fra windwos. Hvordan kan jeg endre koden slik at disse filene ikke blir sendt med på epost?

Sub SendAllFilesInSeparateEmails()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim objFile As Object
Dim strWindowsFolder As String
Dim objFileSystem As Object
Dim objMail As Outlook.MailItem

Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows Folder:", 0, "")

If Not objWindowsFolder Is Nothing Then
   strWindowsFolder = objWindowsFolder.self.Path & "\"
   Set objFileSystem = CreateObject("Scripting.FileSystemObject")
   Set objWindowsFolder = objFileSystem.GetFolder(strWindowsFolder)

   'Send each file in an email
   For Each objFile In objWindowsFolder.Files

       'Create a new mail
       Set objMail = Outlook.Application.CreateItem(olMailItem)
       'Change the details as per your needs
       With objMail
            .Subject = Left(objFile.Name, Len(objFile.Name) - (Len(objFileSystem.GetExtensionName(objFile.Name)) + 1))
            .Attachments.Add objFile.Path
            .Recipients.Add ("epost")
            .Recipients.ResolveAll
            .Send
      End With
   Next

   MsgBox "Bilag send ti PDF faktura", vbOKOnly + vbExclamation
End If
End Sub

[ExcelGuru]

Hei på deg.

Sett inn de to linjene markert i rødt under. De vil sile ut THUMB.DB

 

   'Send each file in an email

   For Each objFile In objWindowsFolder.Files

       If UCase(objFile.Name) <> "THUMB.DB" Then 

       'Create a new mail

       Set objMail = Outlook.Application.CreateItem(olMailItem)

       'Change the details as per your needs

       With objMail

            .Subject = Left(objFile.Name, Len(objFile.Name) - (Len(objFileSystem.GetExtensionName(objFile.Name)) + 1))

            .Attachments.Add objFile.Path

            .Recipients.Add ("epost")

            .Recipients.ResolveAll

            .Send

      End With

      End If 

   Next

 

 

Vennlig hilsen

ExcelGuru.no

Ketil Melhus

[Zafar Iqbal]

Hei,

 

Tusen takk det funka:)