Interne Links in PDF nachträglich Automatisiert erstellen

' Check commandline arguments  
If WScript.Arguments.Count = 1 Then
	file = WScript.Arguments(0)
Else
	MsgBox "Parameteranzahl ist nicht korrekt, bitte nur einen Pfad zu einem PDF übergeben!",vbExclamation  
	WScript.Quit	
End If

' Show info messagebox  
if MsgBox("The following process starts when you click OK and will work in the background. When it's finished, Acrobat will show the modified document and a message will be shown. This process can take some time, so please be patient." & vbNewline & vbNewline & "Shall we start?",vbInformation Or vbSystemModal or vbYesNo,"Link converter script") = vbNo then wscript.quit  

' create objects  
Set objAcro = CreateObject("AcroExch.App")  
Set regex = CreateObject("VBScript.Regexp")  
Set oDic = CreateObject("Scripting.Dictionary")  
Set objShell = CreateObject("Wscript.Shell")  

' set regex object properties  
regex.IgnoreCase = True
regex.Pattern = "^\d+$"  

' action on file  
BatchProcessFile file
' cleanup  
Set fso = Nothing
Set objAcro = Nothing
Set regex = Nothing
Set oDic = Nothing
Set objShell = Nothing

Sub BatchProcessFile(f)
	' create acrobat objects  
	Set docAV = CreateObject("AcroExch.AVDoc")  
	Set docPD = CreateObject("AcroExch.PDDoc")  
	' open pdf  
	ret = docAV.Open(f,"")  

	' get document object  
	Set docPD = docAV.GetPDDoc()
	Set jsDoc = docPD.GetJSObject()
	' iterate over all pages in document  
	For p = 0 To jsDoc.numPages - 1
		' itterate over every word in page  
		For w = 0 To jsDoc.getPageNumWords(p) - 1
			' if word is a '#'  
			If jsDoc.getPageNthWord(p,w,False) = "#" Then  
				' get next word ...  
				markerName = jsDoc.getPageNthWord(p,w + 1,True)
				' ... and check against the regex  
				If regex.Test(markerName) Then
					' get position coordinates of marker  
					pos1 = jsDoc.getPageNthWordQuads(p,w)
					pos2 = jsDoc.getPageNthWordQuads(p,w + 1)
					tlX = pos1(0)(0)
					tlY = pos1(0)(1)
					brX = pos2(0)(6)
					brY = pos2(0)(7)
					' add dictionary entries with marker name as key and value as [PageNum]#[tlX];[tlY];[brX];[brY] joined by '|'  
					If Not oDic.Exists(markerName) Then
						oDic.Add markerName,p & ":" & w+1 & "#" & Join(Array(tlX,tlY,brX,brY),";")  
					Else
						If InStr(1,oDic.Item(markerName),"|",1) = 0 Then  
							oDic.Item(markerName) = oDic.Item(markerName) & "|" & p & ":" & w+1 & "#" & Join(Array(tlX,tlY,brX,brY),";")  
						End If
					End If
				End If
			End If
		Next
	Next
	' iterate over all keys in dictionary  
	For Each k In oDic.Keys
		' split matching markers  
		dItems = Split(oDic.Item(k),"|",2,1)  
		If UBound(dItems) = 1 Then
			' split data of markers  
			dItem1 = Split(dItems(0),"#",2,1)  
			dItem2 = Split(dItems(1),"#",2,1)  
			' get coordinates  
			c1 = Split(dItem1(1),";",4,1)  
			c2 = Split(dItem2(1),";",4,1)  
			' extract page and word position index 0 = page index 1 = word position  
			pwItem1 = Split(dItem1(0),":",2,1)  
			pwItem2 = Split(dItem2(0),":",2,1)  
			
			'create link objects  
			Set l1 = jsDoc.addLink(CInt(pwItem1(0)),Array(CDbl(c1(0)),CDbl(c1(1)),CDbl(c1(2)),CDbl(c1(3))))
			Set l2 = jsDoc.addLink(CInt(pwItem2(0)),Array(CDbl(c2(0)),CDbl(c2(1)),CDbl(c2(2)),CDbl(c2(3))))
			' set link action  
			l1.setAction("this.selectPageNthWord(" & pwItem2(0) & "," & pwItem2(1) & ",true)")  
			l2.setAction("this.selectPageNthWord(" & pwItem1(0) & "," & pwItem1(1) & ",true)")  
		End If
		
	Next
	' Show Acrobat window  
	objAcro.Show
	msgbox "Process finished.",vbInformation Or vbSystemModal,"Link converter script"  
	'jsDoc.saveAs(f)  
	'jsDoc.closeDoc()  
	'objAcro.Hide()  
	'objAcro.Exit()  
	
	Set jsDoc = Nothing
	Set docAV = Nothing
	Set docPD = Nothing
End Sub