PDA

View Full Version : Email With attachments, Changeable users



GribbiN
05-26-2015, 02:02 PM
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

13521

Kenneth Hobs
05-26-2015, 06:50 PM
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
05-27-2015, 02:07 PM
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 :think:


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

13534

Kenneth Hobs
05-27-2015, 05:50 PM
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
05-28-2015, 02:48 AM
Thank for the code, Email generates but no attachments?

Kenneth Hobs
05-28-2015, 12:20 PM
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
05-28-2015, 12:28 PM
You Sir are a legend! Thank you very much

GribbiN
06-05-2015, 01:25 PM
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
06-05-2015, 02:56 PM
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 SubFSO 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
06-05-2015, 03:55 PM
Works perfect, Thank you