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.
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