Email With attachments, Changeable users

[GribbiN]

Hi,
My current work book is used by 4 different users to do the same job. I have recently added email functions to make life easier.

Now so we don't have to manually change the file path to each username in the code i would like to replicate some code used in elsewhere
I want to be able to use a cell range as part of the file path. Cell R3 is named USERNAME is there a line of code to be added after Sub for this to work???? Had to use an image as too many URL's in the code for me to post

Any help greatly appreciated

ScreenHunter_31 May. 26 21.57.jpg

[Kenneth Hobs]

I would make an array with the filenames and then iterate the array and concatenate the desktop path and the subfolder paths.

When you say R3 assigned a value. The ActiveSheet's cell R3 value is:

Range("C3").Value 
'or 
Range("UserName").Value

The desktop path can be found without R3 by this method:

CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator

I don't see any URL strings. You can paste code between code tags by clicking the # icon or typing (code)'your code(/code) and replace ()'s with []'s.

[GribbiN]

Hi Kenneth, Thanks for the reply. Most of what you said went over my head. Non of my code has been written by me I have sourced it all from the internet. I'm very much a keen beginner, I will try to explain my situation better for you.

In my book there is a settings userform where users change the USERNAME to theirs.
For example
jgribbin
khobs
jbloggs
The user name now reside in cell R3 which is named username
Now in the ranges "storefolder" & "checkfiles" is this code
=CONCATENATE("C:\users\",R3,"\Desktop\Walmart ASDA\ScannedDocs\")
So now regardless of user aslong as windows 7 R3 is there username so all directories work without editing code

Now all my current attachments would have to be manually changed to this

.Attachments.Add ("C:\Users\jgribbin\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")
.Attachments.Add ("C:\Users\khobs\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")
.Attachments.Add ("C:\Users\jbloggs\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")
.Attachments.Add ("C:\Users\username\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")
.Attachments.Add ("C:\Users\R3\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")

And i was hoping to mimic the R3 method so that all users can use the email function. Sorry for the terminology

        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")

All files will be in the same folder directories, and named exactly the same on all laptops, all that changes is there username within the file path

Im sorry if i am insulting your intelligence and your previous reply is a solution to this problem, if so can you help me get it into my email code as im lost

Sub Mail_John_Gribbin()    
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = Range("storename") & "" & Range("storeno") & "" & "Scanned Inventory Documents"
        .Body = "Scanned Documents Attached"
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\£1000 Rept.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Crew List.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Record Count.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Recounts.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\SIC.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\LP Review.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\NOFs.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Physicals.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Walk Off.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Schedule 21.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Cost Value.pdf")
        .Attachments.Add = CONCATENATE("C:\Users\", R3, "\Desktop\Walmart ASDA\ScannedDocs\Physical.pdf")
        .send
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Here is the work book for you to take a look if it will help you advise, thanks for your time so far

WIS54Docsv8.xlsm

[Kenneth Hobs]

Note that Debug.Print prints the value to the Immediate Window. You can delete that line or comment it out once you verify that it builds your attachment strings properly. You might also comment out the .Send line while testing.

Sub Mail_John_Gribbin2()  
  Dim OutApp As Object, OutMail As Object
  Dim dt As String, s() As String, ss As String, i As Integer
  
  dt = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Walmart ASDA\ScannedDocs\"
  s() = Split("£1000 Rept.pdf;Crew List.pdf;Record Count.pdf;Recounts.pdf;SIC.pdf;LP Review.pdf;" _
    & "NOFs.pdf;Physicals.pdf;Walk Off.pdf;Schedule 21.pdf;Cost Value.pdf;Physical.pdf ", ";")
   
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
   
  On Error Resume Next
  With OutMail
    .to = ""
    .CC = ""
    .BCC = ""
    .Subject = Range("storename") & "" & Range("storeno") & "" & "Scanned Inventory Documents"
    .Body = "Scanned Documents Attached"
    For i = 0 To UBound(s)
      .Attachments.Add = dt & s(i)
      Debug.Print dt & s(i)
    Next i
   .send
  End With
  On Error GoTo 0
   
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

[GribbiN]

Thank for the code, Email generates but no attachments?

[Kenneth Hobs]

I guess we could check if the file exists or not before attaching files.

You should remove the equals sign as .Add is more of a procedure than a function. That is one of the problems when dealing with late bound objects rather than early bound objects. The latter lets intellisense work to show you the proper syntax before runtime.

.Attachments.Add dt & s(i)

[GribbiN]

You Sir are a legend! Thank you very much

[GribbiN]

Hi Kenneth,
Can you do a similar thing with this code? I don't want my other users having to edit macro's and your email code is perfect and has been tested with multiple users. Thanks again for that

Here's the code i'm currently using which requires a specific file path, again all users have the same directories

Sub Move_Scanned_Files_To_New_Folder()    
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim FNames As String


    FromPath = "C:\Users\jgribbin\Desktop\Walmart ASDA\ScannedDocs"
    ToPath = "C:\Users\jgribbin\Desktop\Walmart ASDA\ScannedDocs\" & Format(Now, "dd-mm-yyyy") & " " & Range("nameofstore") & " #" & Range("storeno") & "\"
    
    FileExt = "*.pdf*"
    
    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If


    FNames = Dir(FromPath & FileExt)
    If Len(FNames) = 0 Then
        MsgBox "No files in " & FromPath
        Exit Sub
    End If


    Set FSO = CreateObject("scripting.filesystemobject")


    FSO.CreateFolder (ToPath)


    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath


End Sub

[Kenneth Hobs]

If I understand, but not tested...

Sub Move_Scanned_Files_To_New_Folder()
      Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim FNames As String
     
    FromPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Walmart ASDA\ScannedDocs"
    ToPath = FromPath & "\" & Format(Now, "dd-mm-yyyy") & " " & Range("nameofstore") & " #" & Range("storeno") & "\"
     
    FileExt = "*.pdf*"
     
    FNames = Dir(FromPath & FileExt)
    If Len(FNames) = 0 Then
        MsgBox "No files in " & FromPath
        Exit Sub
    End If
     
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.CreateFolder (ToPath)
     
    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub

FSO or VBA is good for one level folder creation. IF you want to create more than one level, I can show you how to use the command shell to do it.

[GribbiN]

Works perfect, Thank you