VBA Assign password against each file

[daveyboy23]

Hi guys,

I have a list of files which have been created through another vba I created but now not sure how to apply said password against each of these files. I know I need to create a loop but not sure how to do that in this case.
Furthermore after doing this, each of these files needs to be emailed to said supplier. So any advice with sending these via outlook would be great too.

 

[Kenneth Hobson]

The normal method is to save the files with the password when created. IF you want to do after the fact, a macro would open each file and then save it with the password. If it already has a password, it will error. It would be best to move all of the non-password files to one folder and then run the corrective macro.

For email, would all files in one folder be attached and sent to one email address? If not, how would a macro know where to send each?

 

[daveyboy23]

The macro split out the data for several suppliers and saved each one in a different file. Now though I must open each of these files and assign a different password to each from a designated list of passwords.
I know how to open the files but not then sure how I can then apply a different password to each.
Each of these files will then be emailed to a different supplier , each one sent individually hopefully through coding.

 

[Kenneth Hobson]

It can all be done. The solution depends on the details. Where is this list of passwords, A2 and down to end or array or? How is the filename associated with the password to assign?

How is the email address associated with the filename, B2 and down to end or array or?

 

[daveyboy23]

Thank you for your reply, A1 to A100 contains the file path. B1 to B100 contains the passwords for each file, or rather the pasword to apply and C1 to C100 contains the email address to use.

 

[Kenneth Hobson]

Sub Main()
  Dim c As Range, oL As Object
  
  SaveFilesWithPassword
  
  Set oL = CreateObject("Outlook.Application")
  For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    If Dir(c) = "" Then GoTo NextC
    With oL.createitem(0)
      .To = c.Offset(, 2)
      '.cc = ""
      '.bcc = ""
      .Subject = "File: " & c
      .Body = "Please find your file attached." & vbCrLf & vbCrLf & "Best Regards"
      .Attachments.Add (c)
      '.Display
      .Send
    End With
NextC:
  Next c
  
  Set oL = Nothing
End Sub

Sub SaveFilesWithPassword()
  Dim c As Range

  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

  For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    If Dir(c) = "" Then GoTo NextC
    With Workbooks.Open(c)
      .Visible = False
      .SaveAs c, .FileFormat, c.Offset(, 1)
      .Close False
    End With
NextC:
  Next c
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub