JFlye
07-09-2008, 10:24 AM
Hi everyone,
I am new to these forums and definitely new to VBA and visual basic programming.
I am currently trying to create a document template for use with SharePoint. The idea is that there is a header with a table inside that has pieces of data, which I would like to save as Custom Document Properties. I would like the Custom Document Properties to update when any changes are made to the header. That way, SharePoint can read the Document Properties and upload them as metadata.
My problem is that my coding works locally, but when I upload it to Sharepoint as the template for a Content Type, the coding no longer executes. The coding is clearly there, but nothing happens and no Custom Document Properties are created.
Any help would be greatly appreciated. I am new to all of this so any and all help is appreciated. I am using Word 2003 and SharePoint 2007.
NOTE: My coding is definitely not efficient, but it should function.
Here is the code:
[This Document]
Public Sub Document_Open()
Call AutoExec
End Sub
[Module 1]
Option Explicit
Dim oAppClass As New Class1
Public Sub AutoExec()
Set oAppClass.oApp = Word.Application
ActiveWindow.View.Type = wdPrintView
End Sub
[Class1]
Option Explicit
Public WithEvents oApp As Word.Application
Private Sub oApp_WindowSelectionChange(ByVal Sel As Selection)
If Sel.HeaderFooter.IsHeader Then
Dim title As String
Dim titleexists As Boolean
Dim number As String
Dim numberexists As Boolean
Dim narray() As String
Dim project As String
Dim projectexists As Boolean
Dim parray() As String
Dim site As String
Dim siteexists As Boolean
Dim sarray() As String
Dim customer As String
Dim carray() As String
Dim customerexists As Boolean
Dim ordernumber As String
Dim oarray() As String
Dim ordernumberexists As Boolean
Dim division As String
Dim divisionexists As Boolean
Dim darray() As String
Dim departmentexists As Boolean
Dim department As String
Dim dparray() As String
Dim group As String
Dim garray() As String
Dim groupexists As Boolean
Dim sorder As String
Dim siemensarray() As String
Dim sorderexists As Boolean
' Gather title from cell and add custom property if needed
titleexists = False
title = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(1, 2).Range.Text
title = Left$(title, Len(title) - 4)
title = Trim$(title)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Document Title", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=title, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Document Title").Value = title
' Gather document number from cell and add custom property if needed
numberexists = False
number = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(1, 3).Range.Text
narray() = Split(number, ".")
number = narray(1)
number = Trim$(number)
number = Left$(number, Len(number) - 2)
number = Right$(number, Len(number) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Document Number", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=number, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Document Number").Value = number
' Gather project from cell and add custom property if needed
projectexists = False
project = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 1).Range.Text
parray() = Split(project, ":")
project = parray(1)
project = Trim$(project)
project = Left$(project, Len(project) - 2)
project = Right$(project, Len(project) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Project", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=project, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Project").Value = project
projectexists = True
ProjectErrHandler:
' Gather site location from cell and add custom property if needed
siteexists = False
site = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 2).Range.Text
sarray() = Split(site, ":")
site = sarray(1)
site = Trim$(site)
site = Left$(site, Len(site) - 2)
site = Right$(site, Len(site) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Site Location", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=site, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Site Location").Value = site
' Gather customer from cell and add custom property if needed
customerexists = False
customer = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 3).Range.Text
carray() = Split(customer, ":")
customer = carray(1)
customer = Trim$(customer)
customer = Right$(customer, Len(customer) - 1)
customer = Left$(customer, Len(customer) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Customer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=customer, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Customer").Value = customer
customerexists = True
' Gather order number from cell and add custom property if needed
ordernumberexists = False
ordernumber = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 4).Range.Text
oarray() = Split(ordernumber, ":")
ordernumber = oarray(1)
ordernumber = Trim$(ordernumber)
ordernumber = Right$(ordernumber, Len(ordernumber) - 1)
ordernumber = Left$(ordernumber, Len(ordernumber) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Customer Order Number", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=ordernumber, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Customer Order Number").Value = ordernumber
' Gather division from cell and add custom property if needed
divisionexists = False
division = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 1).Range.Text
darray() = Split(division, ":")
division = darray(1)
division = Trim$(division)
division = Right$(division, Len(division) - 1)
division = Left$(division, Len(division) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Division", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=division, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Division").Value = division
' Gather department from cell and add custom property if needed
departmentexists = False
department = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 2).Range.Text
dparray() = Split(department, ":")
department = dparray(1)
department = Trim$(department)
department = Right$(department, Len(department) - 1)
department = Left$(department, Len(department) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Department", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=department, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Department").Value = department
' Gather department from cell and add custom property if needed
groupexists = False
group = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 3).Range.Text
garray() = Split(group, ":")
group = garray(1)
group = Trim$(group)
group = Right$(group, Len(group) - 1)
group = Left$(group, Len(group) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Group", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=group, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Group").Value = group
' Gather department from cell and add custom property if needed
sorderexists = False
sorder = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 4).Range.Text
siemensarray() = Split(sorder, ":")
sorder = siemensarray(1)
sorder = Trim$(sorder)
sorder = Right$(sorder, Len(sorder) - 1)
sorder = Left$(sorder, Len(sorder) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Order", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=sorder, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Order").Value = sorder
End If
End Sub
I am new to these forums and definitely new to VBA and visual basic programming.
I am currently trying to create a document template for use with SharePoint. The idea is that there is a header with a table inside that has pieces of data, which I would like to save as Custom Document Properties. I would like the Custom Document Properties to update when any changes are made to the header. That way, SharePoint can read the Document Properties and upload them as metadata.
My problem is that my coding works locally, but when I upload it to Sharepoint as the template for a Content Type, the coding no longer executes. The coding is clearly there, but nothing happens and no Custom Document Properties are created.
Any help would be greatly appreciated. I am new to all of this so any and all help is appreciated. I am using Word 2003 and SharePoint 2007.
NOTE: My coding is definitely not efficient, but it should function.
Here is the code:
[This Document]
Public Sub Document_Open()
Call AutoExec
End Sub
[Module 1]
Option Explicit
Dim oAppClass As New Class1
Public Sub AutoExec()
Set oAppClass.oApp = Word.Application
ActiveWindow.View.Type = wdPrintView
End Sub
[Class1]
Option Explicit
Public WithEvents oApp As Word.Application
Private Sub oApp_WindowSelectionChange(ByVal Sel As Selection)
If Sel.HeaderFooter.IsHeader Then
Dim title As String
Dim titleexists As Boolean
Dim number As String
Dim numberexists As Boolean
Dim narray() As String
Dim project As String
Dim projectexists As Boolean
Dim parray() As String
Dim site As String
Dim siteexists As Boolean
Dim sarray() As String
Dim customer As String
Dim carray() As String
Dim customerexists As Boolean
Dim ordernumber As String
Dim oarray() As String
Dim ordernumberexists As Boolean
Dim division As String
Dim divisionexists As Boolean
Dim darray() As String
Dim departmentexists As Boolean
Dim department As String
Dim dparray() As String
Dim group As String
Dim garray() As String
Dim groupexists As Boolean
Dim sorder As String
Dim siemensarray() As String
Dim sorderexists As Boolean
' Gather title from cell and add custom property if needed
titleexists = False
title = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(1, 2).Range.Text
title = Left$(title, Len(title) - 4)
title = Trim$(title)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Document Title", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=title, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Document Title").Value = title
' Gather document number from cell and add custom property if needed
numberexists = False
number = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(1, 3).Range.Text
narray() = Split(number, ".")
number = narray(1)
number = Trim$(number)
number = Left$(number, Len(number) - 2)
number = Right$(number, Len(number) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Document Number", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=number, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Document Number").Value = number
' Gather project from cell and add custom property if needed
projectexists = False
project = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 1).Range.Text
parray() = Split(project, ":")
project = parray(1)
project = Trim$(project)
project = Left$(project, Len(project) - 2)
project = Right$(project, Len(project) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Project", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=project, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Project").Value = project
projectexists = True
ProjectErrHandler:
' Gather site location from cell and add custom property if needed
siteexists = False
site = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 2).Range.Text
sarray() = Split(site, ":")
site = sarray(1)
site = Trim$(site)
site = Left$(site, Len(site) - 2)
site = Right$(site, Len(site) - 1)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Site Location", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=site, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Site Location").Value = site
' Gather customer from cell and add custom property if needed
customerexists = False
customer = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 3).Range.Text
carray() = Split(customer, ":")
customer = carray(1)
customer = Trim$(customer)
customer = Right$(customer, Len(customer) - 1)
customer = Left$(customer, Len(customer) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Customer", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=customer, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Customer").Value = customer
customerexists = True
' Gather order number from cell and add custom property if needed
ordernumberexists = False
ordernumber = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(2, 4).Range.Text
oarray() = Split(ordernumber, ":")
ordernumber = oarray(1)
ordernumber = Trim$(ordernumber)
ordernumber = Right$(ordernumber, Len(ordernumber) - 1)
ordernumber = Left$(ordernumber, Len(ordernumber) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Customer Order Number", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=ordernumber, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Customer Order Number").Value = ordernumber
' Gather division from cell and add custom property if needed
divisionexists = False
division = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 1).Range.Text
darray() = Split(division, ":")
division = darray(1)
division = Trim$(division)
division = Right$(division, Len(division) - 1)
division = Left$(division, Len(division) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Division", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=division, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Division").Value = division
' Gather department from cell and add custom property if needed
departmentexists = False
department = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 2).Range.Text
dparray() = Split(department, ":")
department = dparray(1)
department = Trim$(department)
department = Right$(department, Len(department) - 1)
department = Left$(department, Len(department) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Department", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=department, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Department").Value = department
' Gather department from cell and add custom property if needed
groupexists = False
group = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 3).Range.Text
garray() = Split(group, ":")
group = garray(1)
group = Trim$(group)
group = Right$(group, Len(group) - 1)
group = Left$(group, Len(group) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Group", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=group, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Group").Value = group
' Gather department from cell and add custom property if needed
sorderexists = False
sorder = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).C ell(3, 4).Range.Text
siemensarray() = Split(sorder, ":")
sorder = siemensarray(1)
sorder = Trim$(sorder)
sorder = Right$(sorder, Len(sorder) - 1)
sorder = Left$(sorder, Len(sorder) - 2)
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:="Company Order", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=sorder, LinkSource:=False
ActiveDocument.CustomDocumentProperties("Company Order").Value = sorder
End If
End Sub