create folder if does not exit [Archive]

Joseph89

03-28-2015, 03:50 AM

Hello,

First , I would like create a folder which has a name regarding a cell A1 in C:\Images\ if there is not a folder has same name .then i want to open browse to give a chance to pick a file and save it to the created folder.

Could you please help me ?

mancubus

03-28-2015, 05:53 AM

hi & welcome to the forum.

i recommend you do a google serch for your requirements. trying to solve your requirements by yourself makes you improve your vba skills

that said, try this.

Sub CreateFolderIfNotexists_CopySelectedFile()

Dim FolderName As String, FileName As String

FolderName = "C:\Images\" & Worksheets("Sheet1").Range("A1").Value & "\"
'change sheet name to suit and do not forget to add trailing "\".

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False 'allow selecting one file only
If .Show <> -1 Then
MsgBox "You clicked cancel; please select a file to copy!"
Exit Sub
Else
FileName = .SelectedItems(1)
End If
End With

With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(FolderName) Then
.CreateFolder (FolderName)
End If
.CopyFile FileName, FolderName, True
'set OverWrite argument's value to "True" to overwrite the file if it already exists in the folder.
End With

End Sub

Joseph89

03-28-2015, 06:42 AM

Thanks a lot you for your reply and recommendation , i am beginner about vba but trying improve mysef.

You commented that i need to add trailing but i dont know how to add this maybe because of this i am getting error in this part:(.

And do this code can save the file i selected?

FolderName = "C:\Images\" & Worksheets("Sheet1").Range("A1").Value & "\"
'change sheet name to suit and do not forget to add trailing "\".

mancubus

03-28-2015, 08:09 AM

welcome.

you don't have to do add anything to the code i posted. i have already added it with concatenation operator: &
the comment is for future references.
just change the worksheet name Sheet1 to the worksheet name in your workbook. because your destination folder is C:\Images\ and the value in cell A1.

then run the code.

Joseph89

03-28-2015, 05:34 PM

yes i run it and work perfectly thanks a lot you solved one of my biggest problem but there is just one thing still remain ,i want to get the link where i saved the document in cell A2
I add this code at the end of the code but it does not work
Sayfa1.Range("A2").Value = FolderName

could you help me ?

mancubus

03-29-2015, 03:03 PM

you are welcome.

if you want to add a hyperlink to the copied file, try this:

Sub CreateFolderIfNotexists_CopySelectedFile_InsertHyperlinkToCopiedFile()

Dim FolderName As String, FileFullName As String, FileShortName As String

FolderName = "C:\Images\" & Worksheets("Sheet1").Range("A1").Value & "\"
'change sheet name to suit and do not forget to add trailing "\".

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False 'allow selecting one file only
If .Show <> -1 Then
MsgBox "You clicked cancel; please select a file to copy!"
Exit Sub
Else
FileFullName = .SelectedItems(1)
End If
End With

With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(FolderName) Then
.CreateFolder (FolderName)
End If
.CopyFile FileFullName, FolderName, True
End With

FileShortName = Right(FileFullName, Len(FileFullName) - InStrRev(FileFullName, "\"))

With Worksheets("Sheet1")
.Hyperlinks.Add _
Anchor:=.Range("A2"), _
Address:=FolderName & FileShortName, _
TextToDisplay:=FolderName & FileShortName
End With

End Sub

ps: your homework is to study the vba string functions such as, LEN, LEFT, RIGHT, MID, INSTR, INSTRREV if you are not familiar with.
:)

snb

03-30-2015, 01:15 AM

Sub M_snb()
on error resume next
mkdir "C:\Images\" & activesheet.cells(1).value

activeworkbook.savecopyas "C:\Images\" & activesheet.cells(1).value & "\" & activeworkbook.name
End Sub

Joseph89

03-30-2015, 06:58 AM

hahah thanks again you are right i need to study :yes:yes, i will do my homework

There is one more thing i added a code to take screenshot and mail it and i defined cell "A2" which has hyperlink as a introduction because i want someone who get this mail can click it to reach the folder we created but there is one problem , i can send it but hyperlink in cell "A2" shows like a text and imposible to click:(

Do you know reason for this:(?

Sheet1.Range("A1:R33").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = Sheet1.Range("T4").Value
.Item.To = Sheet2.Range("B111") & "; " & Sheet2.Range("B112")
.Item.CC = Sheet1.Range("V24")
.Item.Subject = Sheet2.Range("M82").Value
.Item.SEND
End With

mancubus

03-31-2015, 12:03 PM

if both you and the recipients of the email use MS Outlook, try:

Sub CreateFolderIfNotexists_CopySelectedFile_InsertHyperlinkToCopiedFile_MailLi nkToFile()

Dim FolderName As String, FileFullName As String, FileShortName As String, MailHtmlBody As String

FolderName = "C:\Images\" & Worksheets("Sheet1").Range("A1").Value & "\" 'change sheet name to suit
'change sheet name to suit and do not forget to add trailing "\".

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False 'allow selecting one file only
If .Show <> -1 Then
MsgBox "You clicked cancel; please select a file to copy!"
Exit Sub
Else
FileFullName = .SelectedItems(1)
End If
End With

With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(FolderName) Then
.CreateFolder (FolderName)
End If
.CopyFile FileFullName, FolderName, True
End With

FileShortName = Right(FileFullName, Len(FileFullName) - InStrRev(FileFullName, "\"))

With Worksheets("Sheet1")
.Hyperlinks.Add _
Anchor:=.Range("A2"), _
Address:=FolderName & FileShortName, _
TextToDisplay:=FolderName & FileShortName
End With

MailHtmlBody = "" & _
Sheet1.Range("T4").Value & " " & _
"The file " & FolderName & FileShortName & " is created. " & _
"<A HREF=""file://" & FolderName & FileShortName & _
""">Click this link to open the file</A>" & _
" Cordially," & _
" Your Name Here Your Title Here"

With CreateObject("Outlook.Application")
With .CreateItem(0)
.To = Sheet2.Range("B111") & "; " & Sheet2.Range("B112")
.CC = Sheet1.Range("V24")
.BCC = ""
.Subject = Sheet2.Range("M82").Value
.HTMLBody = MailHtmlBody
.Display 'display it without sending
'.Send 'send it without displaying
End With
End With

End Sub

modify the variable MailHtmlBody to suit your needs. be very careful about quotation marks and the concatenation operator (&).

replace Your Name Here with your name and Your Title Here with your business title. If not desired you can delete these as well.

you can just use .Display to display the email without sending it or .Send to send it without displaying.

another option is both displaying and sending the email.

in this case, use:

With CreateObject("Outlook.Application")
With .CreateItem(0)
.To = Sheet2.Range("B111") & "; " & Sheet2.Range("B112")
.CC = 'Sheet1.Range("V24")
.BCC = ""
.Subject = Sheet2.Range("M82").Value
.HTMLBody = MailHtmlBody
.Save
.Display
.Send
End With
End With

visit below to learn more about using excel to send emails with outlook:
http://www.rondebruin.nl/win/s1/outlook/mail.htm

mancubus

03-31-2015, 12:12 PM

btw, use VBA tags to display the code posted here as in my codes.

click # button on the Quick Reply. VBA tags will be automatically inserted (without leading and trailing spaces). then paste your code in between these tags:
[ CODE ]paste your code here[ /CODE ]