Hi everyone,
I am insanely new to VBA and I am trying to solve a problem with a macro that was set up by someone else, I probably know where the problem is, but I have no idea how to solve it.
Short story:
I have a list of suppliers with corresponding emailadresses, each supplier has a supplier number and a specific folder path. From this excel file. The macro should be able to create the email with the RIGHT files from the corresponding folder path.
The problem with my macro is that it only works for certain rows perfectly. Very often it will create the email without any attachments when there are several pdf files in the folder path.
This is the code below
THe red labeled text, looks like it has no added value, but as soon as I delete this text, the vba no longer works.
As shown in the screenshot, You can see that it copies row E2:E3000. pastes it in column D. But for some reason it will start hussling the emailadresses
Could someone help me?
Sub Mail()
Sheets("Sheet1").Select
UserName = InputBox("please type in the password")
If UserName <> "belux" Then GoTo wrongname
MsgBox ("yes!")
Dim objol As Object
Dim objmail As Object
Dim objFolder As Object
Dim strFolder As String
Dim fso As Object
Dim fsFolder As Object
Dim fsFile As Object
Dim sh As Worksheet
Dim OutMail As Object
Dim outapp As Object
Dim cell As Range
Dim rng As Range
Dim cell2 As Range
'---------------------------------------------------------------------------------------//
'// Create a folder browser. Note: You can change the last arg (the Empty) to a //
'// string where you want the folder browser to start in, such as: ThisWorkbook.Path//
'// Get the path to the folder user picked. //
'// Create various needed objects. I happen to use late-binding. //
Range("C2:C3000").Select
Selection.Copy
Range("D2").Select
Selection.End(xlUp).Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D2").Select
Set fso = CreateObject("Scripting.FileSystemObject")
Set objol = CreateObject("Outlook.Application")
Set sh = Sheets("sheet1")
Set objmail = objol.CreateItem(0) '(olMailItem)
Set outapp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = outapp.CreateItem(0)
With OutMail
.To = cell.Value
.cc = cell.Offset(0, 2).Value
.Subject = "MM invoices "
.Body = cell.Offset(0, 3).Value & " " & cell.Offset(0, 4).Value & vbCrLf & vbCrLf & cell.Offset(0, 5).Value & vbCrLf & cell.Offset(0, 6).Value & vbCrLf & cell.Offset(0, 7).Value & vbCrLf & vbCrLf & cell.Offset(0, 8) & vbCrLf & cell.Offset(0, 9)
strFolder = cell.Offset(0, 10).Value
Set fsFolder = fso.GetFolder(strFolder)
'// Using the file system object, return/add all the Excel files in the picked //
'// folder. //
For Each fsFile In fsFolder.Files
If fsFile.Name Like "*.pdf" Then
.Attachments.Add strFolder & "\" & fsFile.Name
End If
Next
.Display
End With
Set OutMail = Nothing
End If
Next cell
wrongname:
MsgBox "Sorry, password incorrect"
End Sub
Display More