Funktion
Beschreibung
Zeile 5714 - 5789
Code in WinIBW2 (Makro/VBScript)Sub
Sub URL4083Aufr()
'******************************************************************************
'Funktion ruft Link aus 4083 im Standardbrowser auf.
'Falls 4083 mit =A $ belegt ist, wird automatisch Link zum NP-Repository Rome erzeugt
'und aufgerufen.
'Anforderung von C. Diebel.
'S. Grund, DNB, Maerz 2008
dim url()
boxtitel = "Link 4083 aufrufen"
idn = Application.ActiveWindow.Variable("P3GPP")
If idn = "" then
MsgBox "Diese Funktion kann erst ausgeführt werden, wenn der Titel über eine IDN verfügt.", vbCritical, boxtitel
Exit Sub
End If
kat4083 = katEinlesen("4083")
if isArray(kat4083) then
z = UBound(kat4083)
for y = 1 to z
If InStr(kat4083(y),"=A $") > 1 then
'URL erzeugen
redim preserve url(y)
url(y) = "http://d-nb.info/" & idn & "/34"
text_url = "=A $ (-> " & url(y) & ")"
Else
'URL aus 4083 bearbeiten
u = Mid(kat4083(y),1)
url_beg = InStr(u,"http://")
url_end = url_beg
Do
url_end = InStr(url_end,u,"=")
if url_end <> 0 then
if Mid(u,url_end+2,1) <> " " then
url_end = url_end +2
else
Exit Do
End If
Else
url_end = len(u)
End If
Loop until url_end = 0 or url_end = len(u)
url_end = url_end-url_beg
redim preserve url(y)
url(y) = Mid(u,url_beg,url_end)
text_url = url(y)
End If
text = text & vbCrLf & y & "-->" & Mid(text_url,1,40) & "..."
next
'Wenn mehrere 4083 vorhanden sind, Auswahlfenster
If z > 1 then
Do
strMeld = err_text & "Welchen Link wollen Sie aufrufen?" & vbCrLf & text & vbCrLf & vbCrLf & "Bitte geben Sie die Ziffer des gewünschten Links ein " &_
"und klicken Sie auf 'OK'"
url_nr = InputBox (strMeld,boxtitel)
If url_nr > CStr(z) then
err_text = "!!! " & url_nr & " existiert nicht." & " !!!" & vbCr & "Bitte eine Ziffer zwischen 1 und " & y & " eingeben oder abbrechen." & vbLf & vbLf
End If
loop until url_nr = 0 or (url_nr > 0 and url_nr < CStr(z+1))
Else
url_nr = 1
End If
Else
MsgBox "Es ist keine Kategorie 4083 vorhanden.",vbCritical, boxtitel
End If
If url_nr = 0 then Exit Sub
Application.ShellExecute url(url_nr)
End Sub