Solved

How do I create a button on my Outlook form which creates a new Excel workbook using a template?

Posted on 2007-12-05
23
391 Views
Last Modified: 2012-06-27
I would like to click the "New Form" button on my form and have it go to \\server\share, copy the Excel template to a new file with the user's name and then open that file so i can fill it in. I've attached the code that i have so far. When i try it, i get 'expected end of statement" on this line:

      Dim xlApp As New Excel.Application

I thought this was because i did not have the references for excel set but I did that (I think, not sure how) and it's still giving the error.

Thanks!
'Button to create a new Account Request form

Sub cbuttonAttach_Click()

	' Insert hyperlink to the new form and change the subject on the task

	Dim AcctName

	Set AcctName = Item.UserProperties("Requestor/Caller")

	item.body="<\\hcterm\pub\" & AcctName & ".xls>" 

	item.subject="Process Account Request Form" 

	item.save
 

	Dim xlApp As New Excel.Application

	Dim xlWB As New Excel.Workbook

	Dim oSheet As Excel.Worksheet

	Set xlApp = CreateObject("Excel.Application")

	xlApp.Visible = True
 

	Dim sSourceFile' As String

	Dim sDestDir' As String

	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLT"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"
 

	'Check source file exists

	If Dir$(sSourceFile) = "" Then

	MsgBox "Source File Not Found"

	Else

	'Make dest dir If required

	If Dir(sDestDir, vbDirectory) = "" Then

	MkDir sDestDir

	End If

	'Copy the template file to new empty form with the user's name	

	FileCopy sSourceFile, sDestDir & "\" & AcctName & ".xls"

	End If

End Sub

Open in new window

0
Comment
Question by:hartwellcorp
  • 11
  • 10
  • 2
23 Comments
 

Author Comment

by:hartwellcorp
ID: 20413735
I think I'm making this too complicated. the first step should be simple, copy a file by clicking the button on the outlook form. when i try this, it says "type mismatch: FileCopy".

Sub cbuttonAttach_Click()
Set fs = CreateObject("Scripting.FileSystemObject")
sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLT"
sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"      
FileCopy sSourceFile, sDestDir
End Sub
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 20414433
Hello hartwellcorp,

Is this an Outlook form, or a VBA UserForm?  If the former, those use VBScript, and in VBScript
you cannot Dim a variable "as" any particular type.  Instead you would use:

Dim xlApp
Set xlApp = CreateObject("Excel.Application")

Regards,

Patrick
0
 

Author Comment

by:hartwellcorp
ID: 20415028
okay, i fixed that but now i get: type mismatch filecopy
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 20415102
Replace:

FileCopy sSourceFile, sDestDir

with:

Set fil = fs.GetFile(sSourceFile)
fil.Move sDestDir & "\" & fil.Name
0
 
LVL 11

Expert Comment

by:TWBit
ID: 20415355
Sorry I couldn't help much before, but I took some time to look into it.  This should do everything except write the file as the user's name. I tested it locally with a local file and local folder. Not sure if UNC will thow it off.  Let me look into that a bit more, or maybe someone else knows how to get the user.
Sub CommandButton1_Click()
 

	Dim objExcel

	Dim objWorkbook

 	Dim objFSO

	Dim sSourceFile

	Dim sDestDir
 

	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLT"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS" 
 

	Set objFSO = CreateObject("Scripting.FileSystemObject")
 

	'Check source file exists

	If not objFSO.fileexists(sSourceFile) Then

		MsgBox "Source File Not Found"

	Else

		'Make dest dir If required

		If not objFSO.FolderExists(sDestDir) Then

			objFSO.CreateFolder sDestDir

		End If
 

		'Copy the template file to new empty form with the user's name	

		objFSO.CopyFile sSourceFile, sDestDir & "\Test.xls"

	End if
 

	Set objExcel = CreateObject("Excel.Application")

	objExcel.Workbooks.Open sDestDir & "\Test.xls"

	objExcel.Visible = true
 

End Sub

Open in new window

0
 

Author Comment

by:hartwellcorp
ID: 20415599
that's excellent! However, the file that opens in Excel says test1.xls for some reason. the file test.xls is created as expected, but then the file that opens is test1 and if i change it and click save, it brings up the save as dialog as though it was not already saved in that location.
0
 
LVL 11

Expert Comment

by:TWBit
ID: 20415714
I got that too because it is a Template (XLT) and not an XLS.  But when using XLS it is fine.
0
 

Author Comment

by:hartwellcorp
ID: 20415879
awesome. it's working. do you know how to prompt for a name before copying the file and use that as the file name?
0
 
LVL 11

Expert Comment

by:TWBit
ID: 20415902
This should be working now.  Just remember that since the source file is an XLT and you are saving it as an XLS, the file type is still a Template and when saving, you will see the Save As dialog box because you are now saving it as an XLS.  To avoid this, keep it as an XLT during the copy, or change the source file to an XLS.

Sub CommandButton1_Click()

 

	Dim objExcel

	Dim objWorkbook

 	Dim objFSO

	Dim sSourceFile

	Dim sDestDir

 

	'Get user name that is signed on. Might not work if W2k user not member of Administrator group

	strComputer = "."

	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

	Set colItems = objWMIService.ExecQuery("Select * From Win32_ComputerSystem")

	For Each objItem in colItems

	    arrName = Split(objItem.UserName, "\")

	Next
 

	'Set source file and destination folder

	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLT"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"

 

	'Set up FileScriptingObject

	Set objFSO = CreateObject("Scripting.FileSystemObject")

 

	'Check source file exists

	If not objFSO.fileexists(sSourceFile) Then

		MsgBox "Source File Not Found"

	Else

		'Make dest dir If required

		If not objFSO.FolderExists(sDestDir) Then

			objFSO.CreateFolder sDestDir

		End If

 

		'Copy the template file to new empty form with the user's name	

		objFSO.CopyFile sSourceFile, sDestDir & "\" & arrName(1) & ".XLS"

	End if

 

	'Open Excel with the new file

	Set objExcel = CreateObject("Excel.Application")

	objExcel.Workbooks.Open sDestDir & "\" & arrName(1) & ".XLS"

	objExcel.Visible = true

 

End Sub

Open in new window

0
 
LVL 11

Expert Comment

by:TWBit
ID: 20415954
If you wanted to prompt the user for a filename, add the following two line:

      dim fname
      fname=InputBox("Enter a name (without extension) for the new file:")

Then change the arrName(1) occurances to fname.

But that could lead to some errors - you never know what they will type in.
0
 

Author Comment

by:hartwellcorp
ID: 20415996
that almost works. when i am prompted, i type the name "test" and i get an error:

object required : [string: "test"]
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 11

Expert Comment

by:TWBit
ID: 20416030
On what line? Please re-attach your latest code.
0
 

Author Comment

by:hartwellcorp
ID: 20416176
It doesnt say what line, but i get that error when i enter "test" at the name prompt.
Sub cbuttonAttach_Click()

 	' Insert hyperlink to the new form and change the subject on the task

	Dim AcctName

	Dim objExcel

	Dim objWorkbook

 	Dim objFSO

	Dim sSourceFile

	Dim sDestDir
 

	Set AcctName = InputBox("Enter a name (without extension) for the new file:") 

'	Set AcctName = Item.UserProperties("Requestor/Caller")

	Set objFSO = CreateObject("Scripting.FileSystemObject")

 	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLT"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"

	

	'Check source file exists

	If Not objFSO.fileexists(sSourceFile) Then

		MsgBox "The template file was not found at:  " & sSourceFile

	Else

	End If

	'Copy the template file to new empty form with the user's name	

	objFSO.CopyFile sSourceFile, sDestDir & "\" & AcctName & ".xls"

 	item.body=" Please fill out this Account Request Form for " & AcctName & ": <\\hcterm\pub\accountrequestforms\" & AcctName & ".xls>" & "... Once you're done filling out the form, reply to this message so we can get started on it." 

	item.subject="Process Account Request Form" 

	item.save

	End If	

End Sub

Open in new window

0
 
LVL 11

Expert Comment

by:TWBit
ID: 20416189
There is no Set statement.
0
 

Author Comment

by:hartwellcorp
ID: 20416223
Do you mean that the Set statement is missing from my code or that i should not have put a Set statement on the prompt line?

      Set AcctName = InputBox("Enter a name (without extension) for the new file:")
0
 
LVL 11

Expert Comment

by:TWBit
ID: 20416237
You shouldn't have put it in on line 10. I didn't have it in the code I asked you to use.
0
 

Author Comment

by:hartwellcorp
ID: 20416260
okay, here's my code again. i removed the Set statement on the prompt line and now it works, thanks for that! I also changed the code so that it's copying an XLS file instead of XLT file but it still brings up the save as dialog when I'm closing it.
Sub cbuttonAttach_Click()

 	' Insert hyperlink to the new form and change the subject on the task

	Dim AcctName

	Dim objExcel

	Dim objWorkbook

 	Dim objFSO

	Dim sSourceFile

	Dim sDestDir
 

	AcctName = InputBox("Enter a name (without extension) for the new file:") 

'	Set AcctName = Item.UserProperties("Requestor/Caller")

	Set objFSO = CreateObject("Scripting.FileSystemObject")

 	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLS"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"

	

	'Check source file exists

	If Not objFSO.fileexists(sSourceFile) Then

		MsgBox "The template file was not found at:  " & sSourceFile

	Else

	End If

	'Copy the template file to new empty form with the user's name	

	objFSO.CopyFile sSourceFile, sDestDir & "\" & AcctName & ".xls"

 	item.body=" Please fill out this Account Request Form for " & AcctName & ": <\\hcterm\pub\accountrequestforms\" & AcctName & ".xls>" & "... Once you're done filling out the form, reply to this message so we can get started on it." 

	item.subject="Process Account Request Form" 

	item.save

	'Open Excel with the new file

	Set objExcel = CreateObject("Excel.Application")

	objExcel.Workbooks.Open sDestDir & "\" & AcctName & ".XLS"

	objExcel.Visible = True
 

End Sub

Open in new window

0
 
LVL 11

Expert Comment

by:TWBit
ID: 20416277
Did you re-save the original SourceFile as an XLS, or just change the extension?  As I said, changing the extension doesn't change the file type.  Saving a Template type workbook prompts you to SaveAs.
0
 

Author Comment

by:hartwellcorp
ID: 20416320
You got it. Sorry, I missed that previously. Thanks for all your help. I just realized something though. if i name the file by the user's name, it will get overwritten the next time that name is used. can i append the file name with a serial number, like todays date or something like that?
Sub cbuttonAttach_Click()

 	' Insert hyperlink to the new form and change the subject on the task

	Dim AcctName

	Dim objExcel

	Dim objWorkbook

 	Dim objFSO

	Dim sSourceFile

	Dim sDestDir
 

	AcctName = InputBox("Enter the user's name") 

'	Set AcctName = Item.UserProperties("Requestor/Caller")

	Set objFSO = CreateObject("Scripting.FileSystemObject")

 	sSourceFile = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS\COMPUTERACCOUNTREQUESTFORM.XLS"

	sDestDir = "\\HCTERM\PUB\ACCOUNTREQUESTFORMS"

	

	'Check source file exists

	If Not objFSO.fileexists(sSourceFile) Then

		MsgBox "The template file was not found at:  " & sSourceFile

	Else

	End If

	'Copy the template file to new empty form with the user's name	

	objFSO.CopyFile sSourceFile, sDestDir & "\" & AcctName & ".xls"

 	item.body=" Please fill out this Account Request Form for " & AcctName & ": <\\hcterm\pub\accountrequestforms\" & AcctName & ".xls>" & "... Once you're done filling out the form, reply to this message so we can get started on it." 

	item.subject="Process Account Request Form" 

	item.save

	'Open Excel with the new file

	Set objExcel = CreateObject("Excel.Application")

	objExcel.Workbooks.Open sDestDir & "\" & AcctName & ".XLS"

	objExcel.Visible = True
 

End Sub

Open in new window

0
 

Author Comment

by:hartwellcorp
ID: 20416345
also, when it prompts me for a name and i hit cancel, it errors out. i think i need to tell it what to do when nothing is entered right?
0
 
LVL 11

Accepted Solution

by:
TWBit earned 125 total points
ID: 20416429

To trap for an empty string, you can use something like (add this under line 10)

If IsEmpty(AcctName) then
    'do whatever you want
Else
   'Append the number of seconds since midnight to get a pretty unique filename
   AcctName = trim(AcctName) & round(timer(),0)
End if

0
 

Author Comment

by:hartwellcorp
ID: 20416445
That's perfect, thank you! I'll accept your last comment as the solution, thanks again!
0
 
LVL 11

Expert Comment

by:TWBit
ID: 20416460
If want to learn more about vbscript, search within EE or look at http://www.w3schools.com/vbscript/
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

My experience with Windows 10 over a one year period and suggestions for smooth operation
Outlook Free & Paid Tools
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now