Copying a workbook to selected folder

[v_gyku]

u can atleast help me in this.

While mailing a sheet i want to copy that sheet contents to a temporary created workbook with same name as of selected workbook. and store this temp workbook in the folder which i have created.The problem is how will i store the copy of selected workbook to that folder which i have created.


In the following code:

1)list.text --- is name of the sheet.
2)activeworkbook.name--- i tested with f8 dosn't gives name
3)activesheet.copy-- tested with f8 dont give anything
4).Attachments.Add Wb.FullName--givin path of the sheet selected.
5) Kill Wb.FullName--destroys the copy of workbook creted in mydocuments.

I want this copy of workbook to save in the folder created by me.

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
fileName = List1.Text '& " - " & ActiveWorkbook.name
Debug.Print fileName
For y = 1 To Len(fileName)
TempChar = Mid(fileName, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = txtsubject
.Body = txtmessage
.To = Txtname
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close False
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End If

If there is any unnecess. code plz tell me......

[Bob Phillips]

Not tested, but try this

Sub Test()
    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Filename = List1.Text '& " - " & ActiveWorkbook.name
    Debug.Print Filename
sNewDir = "C:\test"
    MkDir sNewDir
    savename = sNewDir & "\" & StripChars(Filename, "[/,\\,*,?,"",<,>,|,:]", "")
    ActiveSheet.Copy
    Set Wb = ActiveWorkbook
    Wb.SaveCopyAs savename
    Wb.ChangeFileAccess xlReadOnly
    With EmailItem
        .Subject = txtsubject
        .Body = txtmessage
        .To = Txtname
        .Attachments.Add Wb.FullName
        .Send
    End With
    Kill Wb.FullName
    Wb.Close False
Application.ScreenUpdating = True
Set Wb = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
End Sub

Function StripChars(exp, reWhat As String, reWith As String)
Dim oRegExp As Object
    Set oRegExp = CreateObject("VBScript.RegExp")
    oRegExp.Pattern = reWhat
    oRegExp.Global = True
    StripChars = oRegExp.Replace(exp, reWith) 
End Function

[v_gyku]

i want to crete a new folder where the original worksheet is located.

i have written this code:

folderPath = Replace(mypath, Wkb.name, "")-- mypath gives full address of original workbook. Is this line ok if i want path except the workbookname..
because .line1. so now i have the path where i have to crete a folder...
so once the folder is created i will copy that workbook to this folder..

I hope ur getin me..

Dim Num As Long
Dim MaxNum As Long
Dim MinNum As Long
Dim Path As String
MinNum = 1
MaxNum = 1000
Path = folderPath & "RightAnswersTempWorkbooks"
MsgBox (folderPath)
On Error Resume Next
MkDir Path
Err.Clear
Randomize
Do
Num = Int((MaxNum - MinNum + 1) * Rnd + MinNum)
MkDir Path & "\RightAnswersTempWorkbooks" & Num
If Err = 0 Then
Exit Do
Else
Err.Clear
End If
Loop
On Error GoTo 0
MsgBox "Folder Created: " & Path & "\RightAnswersTempWorkbooks" & Num
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim fileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
fileName = List1.Text '& " - " & ActiveWorkbook.name
Debug.Print fileName
SaveName = folderPath & "RightAnswersTempWorkbooks" & Num & "\" & StripChars(fileName, "[/,\\,*,?,"",<,>,|,:]", "")
ActiveSheet.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = txtsubject
.Body = txtmessage
.To = Txtname
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close False
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End If
End Sub

Function StripChars(exp, reWhat As String, reWith As String)
Dim oRegExp As Object
Set oRegExp = CreateObject("VBScript.RegExp")
oRegExp.Pattern = reWhat
oRegExp.Global = True
StripChars = oRegExp.Replace(exp, reWith)
End Function

[Bob Phillips]

i want to crete a new folder where the original worksheet is located.

i have written this code:

folderPath = Replace(mypath, Wkb.name, "")-- mypath gives full address of original workbook. Is this line ok if i want path except the workbookname..
because .line1. so now i have the path where i have to crete a folder...
so once the folder is created i will copy that workbook to this folder..

You c an get the path with

Wkb.Path

BTW, you can wrap your code in VBA tags, there is a green and white button above the message box.

.

[v_gyku]

how wll i destroy the folder created?

[Bob Phillips]

how wll i destroy the folder created?

Why would you want to?

[v_gyku]

i want to destroy the folder which i have created otherwise everytime a folder will be created.This has been told to me in my college.I have to do this way only.
I have just changed a code bit. Its sending the attached sheet to the outlook outbox not sending the mail to the reciepient.

[Bob Phillips]

i want to destroy the folder which i have created otherwise everytime a folder will be created.This has been told to me in my college.I have to do this way only.
I have just changed a code bit. Its sending the attached sheet to the outlook outbox not sending the mail to the reciepient.

What is the point of creating a folder, copying a file to it, then deleting the folder?

[v_gyku]

I am givin u the assignment given in the college:
I have to do it as it is been told.

• On final submit, send an email with the selected worksheets as attachments.
  
  • Check if the folder ?RightAnswersTempWorkbooks? exists in the folder that the original selected workbook is located.

i. If the folder does not exist, create it.

ii. If the folder exists, check for the existence of the folder ?RightAnswersTempWorkbooks<random number>? until a folder name is found that does not exist. Create the folder.

1. This check can be done in other ways, but it is a requirement.

• • For each selected worksheet, create a temporary workbook with the file name ?<worksheet name>.xls? in the folder created in step ?a? above. The temp workbook will contain one worksheet with a copy of the data in the selected worksheet. It will also have the same name as the selected worksheet.
  • Attach each temp workbook to the email and send it to the selected recipients with the subject and body.
  • After the email is sent, delete the temporary workbooks directory created in step ?a?.