[Word 2010] VBA to run on startup and to list templates
Hello,
I have written most of my code already I just need a little push to get the last little bits done.
1) What I am needing to do, when a YES/NO option is presses to create a new document I want it to list a load of templates that the user can choose from, when this template is selected the user can still use all the previous macros.
2) I also want to be able to make so that when a user opens up Word they already have an extra tab on their ribbon with all the macros contained. (Hopefully without me having to do this for each user)
This is my code:
[VBA]
Sub ChangeUser()
'
' ChangeUser Macro
Dim FileNameIni As String
'Gets the information out of the INI file (INI needs to be changed for each user)
FileNameIni = "C:\Users\Ballinger.SIDNEYPHILLIPS\Documents\user_config.ini" 'Where ini File is stored
sUserInitials = System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") 'Puts the ini file into the variable
'System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") = "Test"
'Current User is
If MsgBox("Current user is " & sUserInitials & ". Do you want to change this?", vbYesNo) = vbYes Then
changeName = InputBox("Enter new user")
System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") = changeName
End If
End Sub
Sub OpenV2()
Dim oFSO As New FileSystemObject
Dim oFS
Dim Ar(5) As String ' 5 cells in array
Dim i As Integer ' pointer
Dim username As String
Dim stext As String
Dim sText2 As String
Dim fileLocation As String
Dim FileNameIni As String
username = Environ("USERNAME") 'Gets the username of the current user (Windows enviroment)
'Gets the information out of the INI file (INI needs to be changed for each user)
FileNameIni = "C:\Users\" & username & ".SIDNEYPHILLIPS\Documents\user_config.ini" 'Where ini File is stored
sUserInitials = System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") 'Puts the ini file into the variable
i = 1 'Makes sure that the first cell of the array is written too.
'Checks to see if the file path exists. (Stops run time errors)
If Dir("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") <> "" Then
Set oFS = oFSO.OpenTextFile("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") 'Opens the file (Path on server)
'Set oFS = oFSO.OpenTextFile("c:\amipro.cfg") 'Tests - Not Needed
'read property number
Do Until oFS.AtEndOfStream
stext = oFS.ReadLine 'Puts file into variable
sText2 = Right(stext, 16) 'Gets the last 16 characters of the string (property numbers)
Ar(i) = sText2 'Puts the value into the array (Use Ar(2))
i = i + 1 'Increments number by one so next cell of array is written too.
Loop
'FileLocations
fileLocationDraft = "\\10.1.1.1\msdos\particsDraft\" & Ar(2) & ".docx"
fileLocationFinal = "\\10.1.1.1\msdos\partics\" & Ar(2) & ".docx"
fileLocationTemplate = "C:\Users\" & username & ".SIDNEYPHILLIPS\AppData\Roaming\Microsoft\Templates\"
fileTemplate = "2pagewideV1.1docx.dotm"
'Checks to see if file exists
If Dir(fileLocationDraft) <> "" Then
Documents.Open (fileLocationDraft)
Else
'If statement to test if yes or no has been said, then opens up normal template
If MsgBox("This file does not exist in MS Word, try in Lotus Word Pro. Do you want to create it in MS Word?", vbYesNo) = vbYes Then
Documents.Open fileLocationTemplate & fileTemplate
End If
End If
Else
MsgBox ("Path does not exist, check username")
End If
End Sub
Sub SaveDraft()
'************************************************************************** ****************************************************
Dim oFSO As New FileSystemObject
Dim oFS
Dim Ar(5) As String ' 5 cells in array
Dim i As Integer ' pointer
Dim username As String
Dim stext As String
Dim sText2 As String
Dim fileLocation As String
Dim FileNameIni As String
username = Environ("USERNAME") 'Gets the username of the current user (Windows enviroment)
'Gets the information out of the INI file (INI needs to be changed for each user)
FileNameIni = "C:\Users\" & username & ".SIDNEYPHILLIPS\Documents\user_config.ini" 'Where ini File is stored
sUserInitials = System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") 'Puts the ini file into the variable
i = 1 'Makes sure that the first cell of the array is written too.
'Checks to see if the file path exists. (Stops run time errors)
If Dir("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") <> "" Then
Set oFS = oFSO.OpenTextFile("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") 'Opens the file (Path on server)
'Set oFS = oFSO.OpenTextFile("c:\amipro.cfg") 'Tests - Not Needed
'read property number
Do Until oFS.AtEndOfStream
stext = oFS.ReadLine 'Puts file into variable
sText2 = Right(stext, 16) 'Gets the last 16 characters of the string (property numbers)
Ar(i) = sText2 'Puts the value into the array (Use Ar(2))
i = i + 1 'Increments number by one so next cell of array is written too.
Loop
'FileLocations
fileLocationDraft = "\\10.1.1.1\msdos\particsDraft\" & Ar(2) & ".docx"
fileLocationFinal = "\\10.1.1.1\msdos\partics\" & Ar(2) & ".docx"
fileLocationTemplate = "C:\Users\" & username & ".SIDNEYPHILLIPS\AppData\Roaming\Microsoft\Templates\"
fileTemplate = "2pagewideV1.1docx.dotm"
'************************************************************************** **********************************************
If Dir("") < "\\10.1.1.1\msdos\particsDraft\" & Ar(2) > "" Then
ActiveDocument.SaveAs2 (fileLocationDraft)
MsgBox ("File Saved")
Else
MsgBox ("Path: \\10.1.1.1\msdos\particsDraft\" & Ar(2) & " Could not be found")
Else
MsgBox ("Path does not exist, please check username")
End If
End Sub
Sub SaveFinal()
'************************************************************************** ****************************************************
Dim oFSO As New FileSystemObject
Dim oFS
Dim Ar(5) As String ' 5 cells in array
Dim i As Integer ' pointer
Dim username As String
Dim stext As String
Dim sText2 As String
Dim fileLocation As String
Dim FileNameIni As String
username = Environ("USERNAME") 'Gets the username of the current user (Windows enviroment)
sDate = Format(DateValue(Now())) 'Gets the current date
'Gets the information out of the INI file (INI needs to be changed for each user)
FileNameIni = "C:\Users\" & username & ".SIDNEYPHILLIPS\Documents\user_config.ini" 'Where ini File is stored
sUserInitials = System.PrivateProfileString(FileNameIni, "SPAS", "UserInitials") 'Puts the ini file into the variable
i = 1 'Makes sure that the first cell of the array is written too.
'Checks to see if the file path exists. (Stops run time errors)
If Dir("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") <> "" Then
Set oFS = oFSO.OpenTextFile("\\10.1.1.1\msdos\users\" & sUserInitials & "\amipro.cfg") 'Opens the file (Path on server)
'Set oFS = oFSO.OpenTextFile("c:\amipro.cfg") 'Tests - Not Needed
'read property number
Do Until oFS.AtEndOfStream
stext = oFS.ReadLine 'Puts file into variable
sText2 = Right(stext, 16) 'Gets the last 16 characters of the string (property numbers)
Ar(i) = sText2 'Puts the value into the array (Use Ar(2))
i = i + 1 'Increments number by one so next cell of array is written too.
Loop
'FileLocations
fileLocationDraft = "\\10.1.1.1\msdos\particsDraft\" & Ar(2) & ".docx"
fileLocationDraftFinal = "\\10.1.1.1\msdos\particsDraft\" & Ar(2) & "_" & sDate & ".docx"
fileLocationFinal = "\\10.1.1.1\msdos\partics\" & Ar(2)
fileLocationTemplate = "C:\Users\" & username & ".SIDNEYPHILLIPS\AppData\Roaming\Microsoft\Templates\"
fileTemplate = "2pagewideV1.1docx.dotm"
'************************************************************************** **********************************************
If Dir("") < "\\10.1.1.1\msdos\particsDraft\" & Ar(2) > "" Then
ActiveDocument.SaveAs2 (fileLocationDraft)
ActiveDocument.SaveAs2 (fileLocationDraftFinal)
MsgBox ("DraftSaved")
Else
MsgBox ("Path: \\10.1.1.1\msdos\particsDraft\" & Ar(2) & " Could not be found")
End If
If Dir("") < "\\10.1.1.1\msdos\partics\" & Ar(2) > "" Then
ActiveDocument.SaveAs fileLocationFinal, FileFormat:=wdFormatPDF
MsgBox ("Final PDF saved")
Else
MsgBox ("Path: \\10.1.1.1\msdos\particsDraft\" & Ar(2) & " Could not be found")
End If
Else
MsgBox ("Path does not exist, please check username")
End If
End Sub
[/VBA]
