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
421 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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
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
 
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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Outlook creates tmp files 2 39
Redirecting an Outlook attachment to a specific folder? 3 46
Parsing an RSS Feed 4 15
outlook 6 34
Resolve DNS query failed errors for Exchange
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
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…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

813 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

15 Experts available now in Live!

Get 1:1 Help Now