├── CatalogLookup.nsi
├── CatalogLookup.xlam
├── LICENSE
├── README.md
├── customUI
├── customUI.xml
└── images
│ └── library.jpg
├── img
├── baseurl.jpg
├── dialog-data.jpg
├── dialog.jpg
├── example1.jpg
├── example2.jpg
├── example3.jpg
├── example4.jpg
├── example5.jpg
├── large-librarysymbol.jpg
└── ribbon.jpg
├── libxml2x64.dll
├── libxml2x86.dll
├── libxsltx64.dll
├── libxsltx86.dll
├── src.vba
├── AdditionalFieldsDialog.frm
├── Catalog.vba
├── LookupDialog.frm
├── OtherSourcesDialog.frm
├── SearchingDialog.frm
└── UserPassForm.frm
├── yaz5x64.dll
└── yaz5x86.dll
/CatalogLookup.nsi:
--------------------------------------------------------------------------------
1 | ; NSIS Excel Add-In Installer Script
2 |
3 | RequestExecutionLevel user
4 | !include MUI.nsh
5 | !include LogicLib.nsh
6 |
7 | ; General
8 | !define filename "CatalogLookup.xlam"
9 | !define yazdllx86 "yaz5x86.dll"
10 | !define yazdllx64 "yaz5x64.dll"
11 | !define yazdll "yaz5.dll"
12 | !define libxml2x86 "libxml2x86.dll"
13 | !define libxsltx86 "libxsltx86.dll"
14 | !define libxml2x64 "libxml2x64.dll"
15 | !define libxsltx64 "libxsltx64.dll"
16 | !define libxml2 "libxml2.dll"
17 | !define libxslt "libxslt.dll"
18 | !define displayname "Excel Local Catalog Lookup"
19 |
20 | Name "${displayname}"
21 | OutFile "CatalogLookupInstaller.exe"
22 | InstallDir "$APPDATA\${displayname}"
23 | InstallDirRegKey HKCU "Software\${displayname}" "InstallDir" ;
24 |
25 | !insertmacro MUI_PAGE_WELCOME
26 | !insertmacro MUI_PAGE_DIRECTORY
27 | !insertmacro MUI_PAGE_INSTFILES
28 | !insertmacro MUI_PAGE_FINISH
29 |
30 | !insertmacro MUI_UNPAGE_WELCOME
31 | !insertmacro MUI_UNPAGE_CONFIRM
32 | !insertmacro MUI_UNPAGE_INSTFILES
33 | !insertmacro MUI_UNPAGE_FINISH
34 |
35 | !insertmacro MUI_LANGUAGE "English"
36 |
37 | ; Interface Settings
38 | !define MUI_ABORTWARNING
39 |
40 |
41 | ;Prerequisites section
42 |
43 | Section "-Prerequisites"
44 | SectionEnd
45 |
46 | SetOverwrite On
47 |
48 | Var /GLOBAL xlVerReg
49 | Var /GLOBAL xlVerNo
50 | Var /GLOBAL i
51 | Var /GLOBAL keyname
52 | Var /GLOBAL keyname2
53 | Var /GLOBAL keyprefix
54 | Var /GLOBAL openpath
55 | Var /GLOBAL openname
56 | Var /GLOBAL removeold
57 | Var /GLOBAL namelen
58 | Var /GLOBAL lastblankkey
59 |
60 | ; Installer Section
61 | Section "-Install"
62 | SetOutPath $INSTDIR
63 |
64 | ClearErrors
65 | FileOpen $R0 $INSTDIR\tmp.dat w
66 | FileClose $R0
67 | Delete $INSTDIR\tmp.dat
68 | ${If} ${Errors}
69 | Abort "User does not have permission to write to the output directory."
70 | ${EndIf}
71 |
72 | ClearErrors
73 | FileOpen $R0 "$INSTDIR\${filename}" a
74 | FileClose $R0
75 | ${If} ${Errors}
76 | Abort "Excel is open. Please close Excel before trying to install."
77 | ${EndIf}
78 |
79 | ; Check Installed Excel Version
80 | ReadRegStr $xlVerReg HKCR "Excel.Application\CurVer" ""
81 |
82 | ${If} $xlVerReg == 'Excel.Application.12' ; Excel 2007
83 | StrCpy $xlVerNo "12.0"
84 | ${ElseIf} $xlVerReg == 'Excel.Application.14' ; Excel 2010
85 | StrCpy $xlVerNo "14.0"
86 | ${ElseIf} $xlVerReg == 'Excel.Application.15' ; Excel 2013
87 | StrCpy $xlVerNo "15.0"
88 | ${ElseIf} $xlVerReg == 'Excel.Application.16' ; Excel 2016
89 | StrCpy $xlVerNo "16.0"
90 | ${Else}
91 | Abort "An appropriate version of Excel is not installed. $\n${displayname} setup will be canceled."
92 | ${EndIf}
93 |
94 |
95 | StrCpy $removeold "false"
96 | StrLen $namelen "${filename}"
97 | IntOp $namelen $namelen * -1
98 | IntOp $namelen $namelen - 1
99 | StrCpy $i 0
100 | loop:
101 | EnumRegValue $keyname HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $i
102 | StrCmp $keyname "" done
103 | StrCpy $keyprefix $keyname 4
104 | ${If} $keyprefix == "OPEN"
105 | ReadRegStr $openpath HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $keyname
106 | StrCpy $openname $openpath "" $namelen
107 | StrCpy $openname $openname -1
108 | StrCpy $openpath $openpath $namelen
109 | StrCpy $openpath $openpath "" 1
110 | ${If} "$openname" == "${filename}"
111 | ${If} $removeold == "false"
112 | MessageBox MB_YESNO "This plugin is already installed. Replace existing version?" IDYES 0 IDNO abort
113 | StrCpy $removeold "true"
114 | ${EndIf}
115 | Delete "$openpath\x86\*"
116 | RMDir "$openpath\x86"
117 | Delete "$openpath\x64\*"
118 | RMDir "$openpath\x64"
119 | Delete "$openpath\*"
120 | RMDir "$openpath"
121 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $keyname
122 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Add-in Manager" "$openpath\${filename}"
123 |
124 | EnumRegValue $keyname2 HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $i
125 | ${If} $keyname == $keyname2
126 | ${Else}
127 | IntOp $i $i - 1
128 | ${EndIf}
129 | ${EndIf}
130 | ${EndIf}
131 | IntOp $i $i + 1
132 | Goto loop
133 | done:
134 | Goto writekeys
135 | abort:
136 | Abort
137 |
138 | writekeys:
139 | ; Find available "OPEN" key
140 | Var /GLOBAL keyvalue
141 | StrCpy $i ""
142 | loop2:
143 | ReadRegStr $keyvalue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i"
144 | ${If} $keyvalue == ""
145 | ; Available OPEN key found
146 | WriteRegStr HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i" '"$INSTDIR\${filename}"'
147 | ${Else}
148 | IntOp $i $i + 1
149 | Goto loop2
150 | ${EndIf}
151 |
152 | ;Remove any other gaps
153 | StrCpy $i ""
154 | StrCpy $lastblankkey ""
155 | loop3:
156 | ReadRegStr $keyvalue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i"
157 | ${If} $keyvalue == ""
158 | ${If} $lastblankkey == ""
159 | StrCpy $lastblankkey "OPEN$i"
160 | ${EndIf}
161 | ${Else}
162 | ${If} $lastblankkey == ""
163 | ${Else}
164 | WriteRegStr HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $lastblankkey $keyvalue
165 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i"
166 | StrCpy $lastblankkey "OPEN$i"
167 | ${EndIf}
168 | ${EndIf}
169 | IntOp $i $i + 1
170 | ${If} $i < 1000
171 | Goto loop3
172 | ${EndIf}
173 |
174 |
175 | ; Write install data to registry
176 | WriteRegStr HKCU "Software\${displayname}" "InstallDir" $INSTDIR
177 | ; Install Directory
178 | WriteRegStr HKCU "Software\${displayname}" "ExcelCurVer" $xlVerNo
179 | ; Current Excel Version
180 |
181 | CreateDirectory $INSTDIR\x86
182 | CreateDirectory $INSTDIR\x64
183 | ; ADD FILES HERE
184 | File "${filename}"
185 | File "${yazdllx86}"
186 | Rename "${yazdllx86}" "x86\${yazdll}"
187 | File "${yazdllx64}"
188 | Rename "${yazdllx64}" "x64\${yazdll}"
189 | File "${libxml2x86}"
190 | Rename "${libxml2x86}" "x86\${libxml2}"
191 | File "${libxsltx86}"
192 | Rename "${libxsltx86}" "x86\${libxslt}"
193 | File "${libxml2x64}"
194 | Rename "${libxml2x64}" "x64\${libxml2}"
195 | File "${libxsltx64}"
196 | Rename "${libxsltx64}" "x64\${libxslt}"
197 |
198 | ; Write keys to uninstall
199 | WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${displayname}" "DisplayName" "${displayname}"
200 | WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${displayname}" "UninstallString" '"$INSTDIR\uninstall.exe"'
201 | WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${displayname}" "NoModify" 1
202 | WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${displayname}" "NoRepair" 1
203 |
204 | ; Create uninstaller
205 | WriteUninstaller "$INSTDIR\Uninstall.exe"
206 | SectionEnd
207 |
208 |
209 | ; Uninstaller Section
210 | Section "Uninstall"
211 |
212 | ; Find AddIn Manager Key and Delete
213 | ; AddIn Manager key name and location may have changed since installation depending on actions taken by user in AddIn Manager.
214 | ; Need to search for the target AddIn key and delete if found.
215 | ReadRegStr $xlVerNo HKCU "Software\${displayname}" "ExcelCurVer"
216 |
217 | StrLen $namelen "${filename}"
218 | IntOp $namelen $namelen * -1
219 | IntOp $namelen $namelen - 1
220 |
221 | StrCpy $i 0
222 | loop:
223 | EnumRegValue $keyname HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $i
224 | StrCmp $keyname "" done
225 | StrCpy $keyprefix $keyname 4
226 | ${If} $keyprefix == "OPEN"
227 | ReadRegStr $openpath HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $keyname
228 | StrCpy $openname $openpath "" $namelen
229 | StrCpy $openname $openname -1
230 | StrCpy $openpath $openpath $namelen
231 | StrCpy $openpath $openpath "" 1
232 | ${If} "$openname" == "${filename}"
233 | Delete "$openpath\x86\*"
234 | RMDir "$openpath\x86"
235 | Delete "$openpath\x64\*"
236 | RMDir "$openpath\x64"
237 | Delete "$openpath\*"
238 | RMDir "$openpath"
239 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $keyname
240 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Add-in Manager" "$openpath\${filename}"
241 |
242 | EnumRegValue $keyname2 HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $i
243 | ${If} $keyname == $keyname2
244 | ${Else}
245 | IntOp $i $i - 1
246 | ${EndIf}
247 | ${EndIf}
248 | ${EndIf}
249 | IntOp $i $i + 1
250 | Goto loop
251 | done:
252 |
253 | ;Remove any other gaps
254 | StrCpy $i ""
255 | StrCpy $lastblankkey ""
256 | loop3:
257 | ReadRegStr $keyvalue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i"
258 | ${If} $keyvalue == ""
259 | ${If} $lastblankkey == ""
260 | StrCpy $lastblankkey "OPEN$i"
261 | ${EndIf}
262 | ${Else}
263 | ${If} $lastblankkey == ""
264 | ${Else}
265 | WriteRegStr HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" $lastblankkey $keyvalue
266 | DeleteRegValue HKCU "Software\Microsoft\Office\$xlVerNo\Excel\Options" "OPEN$i"
267 | StrCpy $lastblankkey "OPEN$i"
268 | ${EndIf}
269 | ${EndIf}
270 | IntOp $i $i + 1
271 | ${If} $i < 1000
272 | Goto loop3
273 | ${EndIf}
274 |
275 |
276 | DeleteRegKey HKCU "Software\${displayname}"
277 | DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\${displayname}"
278 | SectionEnd
--------------------------------------------------------------------------------
/CatalogLookup.xlam:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/CatalogLookup.xlam
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | ##########################################################################
2 | # Copyright 2024 Princeton University Library
3 | # Additional copyright may be held by others, as reflected in the commit log
4 | #
5 | # Licensed under the Apache License, Version 2.0 (the "License");
6 | # you may not use this file except in compliance with the License.
7 | # You may obtain a copy of the License at
8 | #
9 | # http://www.apache.org/licenses/LICENSE-2.0
10 | #
11 | # Unless required by applicable law or agreed to in writing, software
12 | # distributed under the License is distributed on an "AS IS" BASIS,
13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14 | # See the License for the specific language governing permissions and
15 | # limitations under the License.
16 | #
17 | # This software includes the YAZ toolkit (Copyright © 1995-2018 Index Data),
18 | # which is distributed under the following license:
19 | #
20 | # https://www.indexdata.com/resources/licenses/
21 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Excel Alma Lookup
2 | An Alma batch-search plugin designed to be used within Excel. When integrated with your local Alma instance, the tool can perform searches by keyword, call number, title, ISBN, ISSN, MMS ID and many other fields based on the spreadsheet data. Selected non-Alma catalogs can also be searched, such as WorldCat, Library of Congress, ReCAP, and BorrowDirect.
3 |
4 | **NEW!** We are interested in suggestions for what features to develop next for this tool. Please let us know your thoughts in the [discussion forum](https://github.com/pulibrary/ExcelAlmaLookup/discussions).
5 |
6 | ## System Requirements
7 | - Microsoft Windows version 7 or higher
8 | - Microsoft Excel version 2007 or higher
9 |
10 | ## Installation
11 |
12 | Download the installer here:
13 |
14 | CatalogLookupInstaller.exe
15 |
16 | Simply run the installer (and be sure to quit Excel before doing so). After the plugin is installed, a new tab “Library Tools” will appear in the Excel ribbon. This tab will contain a button labeled “Look Up in Catalog”.
17 |
18 | (Note: Depending on your computer's security settings, trying to run the installer may pop up a warning that "Windows protected Your PC". If you receive this warning, you can proceed with the installation by clicking "More info" and then "Run anyway".)
19 |
20 |
21 |
22 | The plugin will only be installed under the current user's profile. While it is not possible to automatically install the plugin for all users on a computer, you can specify a custom installation directory. If this directory is accessible to other users on the computer, then they can enable the plugin without having to download and install it themselves. To do so:
23 |
24 | 1. In Excel, go to the "File" tab, and click "Options" in the left sidebar.
25 | 2. In the options window, click "Add-ins" in the left sidebar.
26 | 3. On the bottom of the window, next to "Manage", select "Excel Add-Ins", and click "Go...".
27 | 4. In the dialog that appears, click "Browse...". Navigate to the installation directory, and select the file "CatalogLookup.xlam". Then click "OK".
28 | 5. Click "OK" again in the Add-ins dialog, and close the options window. The "Library Tools" tab and "Look up in Catalog" button should appear, as shown above.
29 |
30 | ## Configuration
31 | Your local Alma instance must have an "SRU Server Type Integration Profile" enabled. Many institutions already have this feature turned on in Alma. If yours does not, you can ask your catalog administrator to enable it, as described in the following documentation:
32 |
33 | https://knowledge.exlibrisgroup.com/Alma/Product_Documentation/010Alma_Online_Help_(English)/090Integrations_with_External_Systems/030Resource_Management/190SRU_SRW_Search
34 |
35 | In order to access certain holdings fields (such as location or call number), the "Add Availability" option must be enabled for the SRU profile. Also, in order to retrieve barcodes and other item-specific fields, "Holdings Options (ISO 20775)" must be set to "Active". However, even without these settings enabled, the tool can retrieve any bibliographic field (and search for many types of holdings and item-related fields, including barcodes).
36 |
37 | The first time you run the tool, you will need to enter your institution's "Base URL for Alma SRU". You can contact your catalog administrator to find out this URL. It typically has the form "https://[myinstitution].alma.exlibrisgroup.com/view/sru/[INSTITUTION_CODE]". For example, the screenshot below shows the Base URL for Princeton's catalog:
38 |
39 |
40 |
41 | After entering the URL, click “Add URL to List” to save the URL for future use. One can save multiple URLs and switch between them in order to search different catalogs. If multiple URLs are saved, these can be viewed in a drop-down menu by clicking the triangular button to the right of the URL. After selecting a URL, you can click “Remove URL from List” to remove it from the drop-down.
42 |
43 | To search a non-Alma catalog (such as WorldCat), click the "Non-Alma Sources" button. A list of available sources will appear. After selecting a source, it will appear in the drop-down menu along with your Alma URLs.
44 |
45 | If your SRU integration requires a username and password, you will be prompted for these. (These are likely different than the personal credentials you use to log into Alma. Check with your catalog administrator.) If searching WorldCat, you will be prompted to enter your authorization number and password. You can save these credentials by checking the "Remember these credentials" box in the login prompt, or delete the saved credentials by clicking the "Clear Credentials" button while the URL is selected.
46 |
47 | ## Setting Up the Query
48 | Open an Excel spreadsheet and highlight the cells containing the data you want to search for in Alma. You can highlight an entire column, or just specific cells, but all the values should be contained in the same column. After highlighting the desired cells, click the “Look Up in Local Catalog” button. The following dialog box will appear:
49 |
50 |
51 |
52 | Below is an explanation of the fields in this dialog:
53 |
54 | **Base URL for Alma SRU**: See the "Configuration" section above.
55 |
56 | **Select a range of cells to look up**: This field indicates which cells contain the values you want to search for. If you selected a range of cells before clicking the button, then this field will already contain the appropriate value. However, it is possible to select a new range of cells by clicking the button to the right of this field. Please note that hidden cells in the indicated range will not be included in the search.
57 |
58 | **Ignore First Row (Header)**: If checked, the first cell in the selected range will not be searched. You should check this if the first row is a header.
59 |
60 | **Generate header row from result types**: This option is available if the "Ignore First Row" option is checked. For each result column, the header row will be populated with the corresponding label from the "Result Types" list.
61 |
62 | **Validate and search equivalent ISBN/SNs**: If checked, and if “Field to search” is set to “ISBN” or “ISSN”, then each ISBN/SN will be validated. If invalid, the value "INVALID" will be output in the result column(s). For ISBNs, the search will be done on both the 10-digit and 13-digit forms, regardless of which form is found in the spreadsheet.
63 |
64 | **Include suppressed records**: If checked, then suppressed records will be included in the search results.
65 |
66 | **Leftmost result column**: The column that will be populated with the first result type. If more than one result type is selected, the others will be put in consecutive columns to the right of the first. By default, the first empty column to the right of the visible spreadsheet data is selected. Use the arrow buttons to select a different column. If the selected column contains data, it will be overwritten (except for hidden cells). Search results will be placed in the same rows as the corresponding search values.
67 |
68 | **Field to search**: This indicates what kind of values are in the selected cells (e.g. ISBN, ISSN, Call Number, Title, or MMS ID). If an ISBN search is done, then spaces, dashes and parenthetical comments (e.g. “(paperback)”) are removed from the value before searching. Currently, the title search does not strip stopwords or do anything else to “clean up” the titles before searching. Thus, title searching will not be as accurate as the other search types. Also, please note that the search term will be treated as a phrase and enclosed in quotes, even if it contains multiple words.
69 |
70 | Besides the search keys in the drop-down list, you can enter any search index supported by the local Alma instance. Clicking the “Additional Fields” button will display a full list of such keys. Selecting an index from this list will enter the appropriate code in “Field to Search”. Note that for non-Alma sources, only a limited number of search types are available, and the "Additional Fields" button is not enabled.
71 |
72 | **Result types**: The type of data to retrieve from the records and output in the spreadsheet. Result types can be specified in a number of different ways:
73 | - Selecting “True/False” will populate the result column with TRUE and FALSE values based on whether the search values were found in the catalog.
74 | - Other result types, such as call numbers and location codes, may be selected from the dropdown list. Result types prefixed with a single asterisk are taken from the availability fields. Those with a double asterisk are from the ISO 20775 Holdings data. Your catalog may require special configuration to retrieve these fields. See the "Configuration" section above for more details. Also, because of limitations of the SRU output, the results may not be predictable for holdings with more than 100 item records attached.
75 | - If the search key is a barcode, any item-level result type (those prefixed with a double asterisk) will be filtered to include only the item records corresponding to that barcode. For other search or result types, all matching fields in the retrieved bibliographic records are included. As noted above, this may not work as expected if a holdings has more than 100 items attached.
76 | - Besides the options in the menu, you can also retrieve any MARC field from the bibliographic record. To retrieve an entire MARC field, enter its 3-digit tag number (e.g. “245”). (For institutions that include availability information in their records, this can be retrieved using the “AVA”, “AVD” or “AVE” tags.)
77 | - By default, some text is removed from the field, such as indicators, subfield tags, and the contents of subfield 6 (linkage). To retain this information in the output, check the option "Include indicators, subfield codes, and linkage in results for full fields".
78 | - A subfield can be retrieved by appending “$” followed by the subfield code (e.g. “245$a”).
79 | - To retrieve the part of an 880 field corresponding to another field or subfield, append “-880” (e.g. “245-880” or “245-880$a”).
80 | - To retrieve a specific substring from a field, append "(X,Y)" where X is the starting position, and Y is the length. For example, 008(35,3) retrieves characters 35 through 37 of field 008 (aka the language code). Character positions are zero-based, (i.e. the first character is in position 0, the second in position 1, etc.). This is to conform with the MARC specifications for fixed fields. Characters can be extracted from the Leader field using "Leader(X,Y)" or "LDR(X,Y)". If Y is set to 0, then the result will include the entire remaining part of the field starting from position X.
81 | - To show only results containing specific text, append # followed by that text. For example “035$a#(OCoLC)” will only retrieve 035a fields containing the text “(OCoLC)” (i.e., OCLC numbers).
82 | - Multiple result types can be selected for output, in which case they will be placed in consecutive columns in the spreadsheet, starting with the one indicated in the “Leftmost result column” field. Use the “Add”, “Remove”, “Move Up” and “Move Down” button to edit or reorder the result types.
83 | - For some non-Alma sources, there are a limited number of result types available, and it is not possible enter a custom value in this field. However, some sources also include a "Holdings" result type in the drop-down, which will retrieve a list of holding institutions for the item in question.
84 |
85 | Note that this tool is designed for running queries on lists of specific titles and identifiers, rather than more general queries that might return a large number of results. Thus, to improve performance, a maximum of 25 records will be retrieved for each row.
86 |
87 | **Field Sets**: Sets of field tags can be saved so that they do not need to be entered manually each time the tool is run. After compiling a list of fields under “Result Types”, click the “New…” button to create and name a new set. The “Load” button will populate the “Result Types” list with the fields in an existing set. “Save” will update the fields in the selected set from the “Result types” list. “Delete” will delete the selected set.
88 |
89 | **Include indicators, subfield codes, and linkage in results for full fields**: If checked (and if a given result type is a full MARC field rather than a subfield), then values that are normally scrubbed out of the results are included. The indicators will appear at the beginning of the field (a blank indicator is represented by the underscore _ character). Each subfield will be prefixed by a dollar sign followed by the subfield code. Also, subfield 6 containing the linkage value will be included if it exists. Note that substrings of the full field can be specified as described above. For example, "245(0,2)" would extract the indicators (the first two characters) from field 245.
90 |
91 | ## Running the Query
92 | After selecting or confirming the range of cells to look up, the field to search, and the result type(s), click “OK” to begin the lookup process. You will see the tool populating the result column(s) with the retrieved values. Hidden rows will be skipped. If a record contains multiple instances of the desired result field/subfield (or, if a call number/location search is done and a record has multiple holdings/items), then all instances will be placed in the result cell, separated by “broken vertical bar” characters (¦). If multiple bibliographic records are retrieved by a single search value, the desired field from each record will be placed in the result cell, separated by solid vertical bars (|).
93 |
94 | A small dialog box will show the progress of the query. You can terminate it at any time by clicking the "Stop Searching" button. You do not have to keep the spreadsheet in the foreground while it is searching. However, you may find that Excel performs more slowly in general until the search is complete.
95 |
96 | ### Reporting Bugs and Making Suggestions
97 |
98 | You can use the [discussion forum](https://github.com/pulibrary/ExcelAlmaLookup/discussions) or open an [issue](https://github.com/pulibrary/ExcelAlmaLookup/issues) if you would like to request features, report bugs, or ask general questions.
99 |
100 | ### Troubleshooting/Known Issues
101 | - Some users have reported that WorldCat queries always return FALSE. If you experience this issue, please ask your IT department to configure your firewall to allow connections to zcat.oclc.org on port 210.
102 |
103 | ## Example
104 | This example illustrates a typical use case. The user starts with a title list containing ISBNs and romanized titles for a set of Chinese books.
105 |
106 |
107 |
108 | They would like to search the catalog to confirm which items are owned by their instituion, and retrieve additional data for those items. Since ISBNs are a more reliable search key than titles, the user highlights column A contianing the ISBNs, then clicks the "Look Up in Catalog" button in the "Library Tools" tab. This brings up the following dialog:
109 |
110 |
111 |
112 | The "Range of cells to lookup up" field already shows the cells that the user highlighted (in this case, the entire column A). So, it is not necessary to change this field. The user sets "Field to Search" to "ISBN". The leftmost result column is also already set to C, which is the first blank column to the right of the data. The user also sets 3 result types:
113 | - Call number - The asterisk indicates that this will be retrieved from the availability fields. (If the user wanted to retrieve the call number from a bibliographic field, they could enter a specific MARC field name, such as 050 or 084).
114 | - 035$a#(OCoLC) - This retrieves all instances of 035$a containing the text "(OCoLC)", i.e. OCLC numbers.
115 | - 245-880$a - This retrieves all instances of 880$a that are linked to the 245 field, i.e. the original-script version of the Chinese titles.
116 |
117 | The user then clicks OK. The screenshot below shows the resulting spreadsheet:
118 |
119 |
120 |
121 | For each row of the spreadsheet, the three data elements mentioned above are output in columns C, D, and E respectively. Since the user selected the option to generate column headers, these appear in the first row. Since the ISBN in row 9 was not found in the catalog, the value FALSE is output in each of these columns.
122 |
123 | The user is now interested in looking up the OCLC numbers that were just retrieved in order to check the WorldCat holdings for each record. They highlight column D, and click the "Look Up in Catalog" button again.
124 |
125 |
126 |
127 | This time, they use the "Non-Alma Sources" button to set the source to "source:worldcat". (If they have done this in the past, then it would already appear in the drop-down list of sources). They set "Field to Search" to "OCLC No." and "Result Types" to "WorldCat Holdings". (It is not necessary to click the "Add" button since there is only one result type.) Column F is automatically selected as the result column.
128 |
129 | When the user clicks the "OK" button, they will be prompted to enter their WorldCat authorization number and password (unless they have entered it before and selected the option to save the login). Then, the tool looks up each OCLC number in WorldCat, and populates column F with a list of holdings codes, separated by the broken bar character.
130 |
131 |
132 |
133 | Note that even though the OCLC numbers include the prefixes "(OCoLC)" and "ocn", these are stripped so that only the number is searched in WorldCat.
134 |
--------------------------------------------------------------------------------
/customUI/customUI.xml:
--------------------------------------------------------------------------------
1 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/customUI/images/library.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/customUI/images/library.jpg
--------------------------------------------------------------------------------
/img/baseurl.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/baseurl.jpg
--------------------------------------------------------------------------------
/img/dialog-data.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/dialog-data.jpg
--------------------------------------------------------------------------------
/img/dialog.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/dialog.jpg
--------------------------------------------------------------------------------
/img/example1.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/example1.jpg
--------------------------------------------------------------------------------
/img/example2.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/example2.jpg
--------------------------------------------------------------------------------
/img/example3.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/example3.jpg
--------------------------------------------------------------------------------
/img/example4.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/example4.jpg
--------------------------------------------------------------------------------
/img/example5.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/example5.jpg
--------------------------------------------------------------------------------
/img/large-librarysymbol.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/large-librarysymbol.jpg
--------------------------------------------------------------------------------
/img/ribbon.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/img/ribbon.jpg
--------------------------------------------------------------------------------
/libxml2x64.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/libxml2x64.dll
--------------------------------------------------------------------------------
/libxml2x86.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/libxml2x86.dll
--------------------------------------------------------------------------------
/libxsltx64.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/libxsltx64.dll
--------------------------------------------------------------------------------
/libxsltx86.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/libxsltx86.dll
--------------------------------------------------------------------------------
/src.vba/AdditionalFieldsDialog.frm:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "AdditionalFieldsDialog"
2 | Attribute VB_Base = "0{EC6688E6-4DA8-4E0A-8610-29EEA530C753}{42AED507-D364-4031-8E6B-6F8EAC0AD77F}"
3 | Attribute VB_GlobalNameSpace = False
4 | Attribute VB_Creatable = False
5 | Attribute VB_PredeclaredId = True
6 | Attribute VB_Exposed = False
7 | Attribute VB_TemplateDerived = False
8 | Attribute VB_Customizable = False
9 | Private Sub PopulateSearchField()
10 | i = AdditionalFieldsDialog.SRUFields.ListIndex
11 | If i = -1 Then
12 | MsgBox ("No field is selected")
13 | Else
14 | With LookupDialog.SearchFieldCombo
15 | .AddItem AdditionalFieldsDialog.SRUFields.List(i, 1), .ListCount - 1
16 | .ListIndex = .ListCount - 2
17 | End With
18 | End If
19 | Catalog.PopulateOperatorCombo
20 | End Sub
21 |
22 | Private Sub CancelAdditionalField_Click()
23 | AdditionalFieldsDialog.Hide
24 | End Sub
25 |
26 | Private Sub FilterBox_Change()
27 | sFilterText = LCase(AdditionalFieldsDialog.FilterBox.Value)
28 | AdditionalFieldsDialog.SRUFields.Clear
29 | If sFilterText = "" Then
30 | AdditionalFieldsDialog.SRUFields.List = Catalog.aExplainFields
31 | Exit Sub
32 | End If
33 | iFilterCount = 0
34 | For i = 0 To UBound(Catalog.aExplainFields)
35 | If InStr(1, LCase(aExplainFields(i, 0) & "|" & aExplainFields(i, 1)), sFilterText) > 0 Then
36 | AdditionalFieldsDialog.SRUFields.AddItem
37 | AdditionalFieldsDialog.SRUFields.List(iFilterCount, 0) = aExplainFields(i, 0)
38 | AdditionalFieldsDialog.SRUFields.List(iFilterCount, 1) = aExplainFields(i, 1)
39 | iFilterCount = iFilterCount + 1
40 | End If
41 | Next i
42 | End Sub
43 |
44 | Private Sub SelectAdditionalField_Click()
45 | PopulateSearchField
46 | AdditionalFieldsDialog.Hide
47 | End Sub
48 |
49 | Private Sub SRUFields_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
50 | PopulateSearchField
51 | AdditionalFieldsDialog.Hide
52 | End Sub
--------------------------------------------------------------------------------
/src.vba/Catalog.vba:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "Catalog"
2 | Global oRegEx As Object
3 | Global oXMLHTTP As Object
4 | Global oXMLDOM As Object
5 | Global oConverter As Object
6 | Global oZConn As LongPtr
7 |
8 | Global aExplainFields As Variant
9 | Global bTerminateLoop As Boolean
10 | Global bKeepTryingURL As Boolean
11 | Global bIsoholdEnabled As Boolean
12 | Global bIsAlma As Boolean
13 | Global sCatalogURL As String
14 | Global sAuth As String
15 | Global aAlmaSearchKeys As Variant
16 |
17 | Global sFileName As String
18 | Global sSheetName As String
19 |
20 | Public Const HKEY_CURRENT_USER = &H80000001
21 | Public Const sVersion = "v1.4.0"
22 | Public Const sRepoURL = "https://github.com/pulibrary/ExcelAlmaLookup"
23 | Public Const sBlacklightURL = "https://catalog.princeton.edu/catalog.json?q="
24 | Public Const sLCCatURL = "http://lx2.loc.gov:210/LCDB"
25 | Public Const sIPLCReshareURL = "https://borrowdirect.reshare.indexdata.com/api/v1/search?type=AllFields&field%5B%5D=fullRecord&lookfor="
26 |
27 | Public Const iMaximumRecords = 25
28 |
29 | Public Const sWCZhost = "zcat.oclc.org"
30 | Public Const sWCZport = 210
31 | Public Const sWCZDB = "OLUCWorldCat"
32 |
33 | Public Const sRegistryDir = "Excel Catalog Lookup"
34 | Public Const sYAZdll = "yaz5"
35 |
36 | #If Win64 Then
37 | Public Const sDllVersion = "x64"
38 | Private Declare PtrSafe Sub CopyMemory Lib "ntdll" Alias "RtlCopyMemory" (Destination As Any, Source As Any, ByVal length As Long)
39 | Private Declare PtrSafe Function SetDefaultDllDirectories Lib "kernel32" (ByVal dwFlags As Long) As LongPtr
40 | Private Declare PtrSafe Function AddDllDirectory Lib "kernel32" (ByVal lpLibDirectory As String) As LongPtr
41 | Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
42 |
43 | Private Declare PtrSafe Function ZOOM_connection_create Lib "yaz5.dll" (ByVal Options As Integer) As LongPtr
44 | Private Declare PtrSafe Sub ZOOM_connection_connect Lib "yaz5.dll" (ByVal c As LongPtr, ByVal Host As String, ByVal portnum As Integer)
45 | Private Declare PtrSafe Function ZOOM_connection_option_get Lib "yaz5.dll" (ByVal c As LongPtr, ByVal key As String) As LongPtr
46 | Private Declare PtrSafe Sub ZOOM_connection_option_set Lib "yaz5.dll" (ByVal c As LongPtr, ByVal key As String, ByVal val As String)
47 | Private Declare PtrSafe Sub ZOOM_connection_destroy Lib "yaz5.dll" (ByVal c As LongPtr)
48 | Private Declare PtrSafe Function ZOOM_connection_errcode Lib "yaz5.dll" (ByVal c As LongPtr) As LongPtr
49 | Private Declare PtrSafe Function ZOOM_connection_search_pqf Lib "yaz5.dll" (ByVal c As LongPtr, ByVal q As String) As LongPtr
50 |
51 | Private Declare PtrSafe Function ZOOM_resultset_size Lib "yaz5.dll" (ByVal r As LongPtr) As Integer
52 | Private Declare PtrSafe Function ZOOM_resultset_record Lib "yaz5.dll" (ByVal r As LongPtr, ByVal pos As Integer) As LongPtr
53 | Private Declare PtrSafe Sub ZOOM_resultset_option_set Lib "yaz5.dll" (ByVal r As LongPtr, ByVal key As String, ByVal val As String)
54 | Private Declare PtrSafe Sub ZOOM_resultset_destroy Lib "yaz5.dll" (ByVal r As LongPtr)
55 |
56 | Private Declare PtrSafe Function ZOOM_record_get Lib "yaz5.dll" (ByVal r As LongPtr, ByVal typ As String, ByRef size As Long) As LongPtr
57 | Private Declare PtrSafe Sub ZOOM_record_destroy Lib "yaz5.dll" (ByVal r As LongPtr)
58 |
59 | #Else
60 | Public Const sDllVersion = "x86"
61 | Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
62 | Private Declare PtrSafe Function SetDefaultDllDirectories Lib "kernel32" (ByVal dwFlags As Long) As LongPtr
63 | Private Declare PtrSafe Function AddDllDirectory Lib "kernel32" (ByVal lpLibDirectory As String) As LongPtr
64 | Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
65 |
66 | Private Declare PtrSafe Function ZOOM_connection_create Lib "yaz5.dll" Alias "_ZOOM_connection_create@4" (ByVal Options As Integer) As LongPtr
67 | Private Declare PtrSafe Sub ZOOM_connection_connect Lib "yaz5.dll" Alias "_ZOOM_connection_connect@12" (ByVal c As LongPtr, ByVal Host As String, ByVal portnum As Integer)
68 | Private Declare PtrSafe Function ZOOM_connection_option_get Lib "yaz5.dll" Alias "_ZOOM_connection_option_get@8" (ByVal c As LongPtr, ByVal key As String) As LongPtr
69 | Private Declare PtrSafe Sub ZOOM_connection_option_set Lib "yaz5.dll" Alias "_ZOOM_connection_option_set@12" (ByVal c As LongPtr, ByVal key As String, ByVal val As String)
70 | Private Declare PtrSafe Sub ZOOM_connection_destroy Lib "yaz5.dll" Alias "_ZOOM_connection_destroy@4" (ByVal c As LongPtr)
71 | Private Declare PtrSafe Function ZOOM_connection_errcode Lib "yaz5.dll" Alias "_ZOOM_connection_errcode@4" (ByVal c As LongPtr) As LongPtr
72 | Private Declare PtrSafe Function ZOOM_connection_search_pqf Lib "yaz5.dll" Alias "_ZOOM_connection_search_pqf@8" (ByVal c As LongPtr, ByVal q As String) As LongPtr
73 |
74 | Private Declare PtrSafe Function ZOOM_resultset_size Lib "yaz5.dll" Alias "_ZOOM_resultset_size@4" (ByVal r As LongPtr) As Integer
75 | Private Declare PtrSafe Function ZOOM_resultset_record Lib "yaz5.dll" Alias "_ZOOM_resultset_record@8" (ByVal r As LongPtr, ByVal pos As Integer) As LongPtr
76 | Private Declare PtrSafe Sub ZOOM_resultset_option_set Lib "yaz5.dll" Alias "_ZOOM_resultset_option_set@12" (ByVal r As LongPtr, ByVal key As String, ByVal val As String)
77 | Private Declare PtrSafe Sub ZOOM_resultset_destroy Lib "yaz5.dll" Alias "_ZOOM_resultset_destroy@4" (ByVal r As LongPtr)
78 |
79 | Private Declare PtrSafe Function ZOOM_record_get Lib "yaz5.dll" Alias "_ZOOM_record_get@12" (ByVal r As LongPtr, ByVal typ As String, ByRef size As Long) As LongPtr
80 | Private Declare PtrSafe Sub ZOOM_record_destroy Lib "yaz5.dll" Alias "_ZOOM_record_destroy@4" (ByVal r As LongPtr)
81 | #End If
82 |
83 | 'Initialize global objects
84 | Private Sub Initialize()
85 | sVer = GetSetting("Excel Catalog Lookup", "General", "Version", "NONE")
86 | If sVer = "NONE" Then
87 | MigrateSettings
88 | End If
89 | sPluginDir = Application.AddIns("CatalogLookup").Path
90 |
91 | On Error GoTo ErrHandler
92 | Set oRegEx = CreateObject("vbscript.regexp")
93 | With oRegEx
94 | .MultiLine = False
95 | .Global = True
96 | .IgnoreCase = True
97 | End With
98 | Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
99 | Set oXMLDOM = CreateObject("MSXML2.DomDocument")
100 | oXMLDOM.SetProperty "SelectionLanguage", "XPath"
101 | Set oConverter = CreateObject("ADODB.Stream")
102 |
103 | SetDefaultDllDirectories (&H1000&)
104 | sDllPath = StrConv(sPluginDir & "\" & sDllVersion & "\", vbUnicode)
105 | AddDllDirectory (sDllPath)
106 | LoadLibrary (sYAZdll)
107 |
108 | Exit Sub
109 | ErrHandler:
110 | MsgBox ("There was an error initializing the plugin. Please try again.")
111 | End Sub
112 |
113 | Sub MigrateSettings()
114 | SaveSetting sRegistryDir, "General", "Version", sVersion
115 | Set oReg = CreateObject("WScript.Shell")
116 | On Error Resume Next
117 | sAuths = oReg.RegRead("HKEY_CURRENT_USER\Software\Excel Local Catalog Lookup\CatalogAuth")
118 | sFieldSets = oReg.RegRead("HKEY_CURRENT_USER\Software\Excel Local Catalog Lookup\FieldSets")
119 | sURLs = oReg.RegRead("HKEY_CURRENT_USER\Software\Excel Local Catalog Lookup\CatalogURL")
120 | If (InStr(1, sAuths, "|") > 0 And InStr(1, sAuths, ChrW(166)) = 0) Or _
121 | (InStr(1, sFieldSets, "|") > 0 And InStr(1, sFieldSets, ChrW(166)) = 0) Then
122 | Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
123 | oReg.GetStringValue HKEY_CURRENT_USER, "Software\Excel Local Catalog Lookup", "CatalogAuth", sAuths
124 | oReg.GetStringValue HKEY_CURRENT_USER, "Software\Excel Local Catalog Lookup", "FieldSets", sFieldSets
125 | oReg.GetStringValue HKEY_CURRENT_USER, "Software\Excel Local Catalog Lookup", "CatalogURL", sURLs
126 | End If
127 | If sURLs <> "" Then
128 | aURLs = Split(sURLs, "|")
129 | aAuths = Split(sAuths, "|")
130 | SaveSetting sRegistryDir, "Sources", "MAX", UBound(aURLs)
131 | SaveSetting sRegistryDir, "Sources", "SELECTED", aURLs(0)
132 | For i = 0 To UBound(aURLs)
133 | SaveSetting sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), aURLs(i)
134 | For j = 0 To UBound(aAuths)
135 | If InStr(1, aAuths(j), aURLs(i) & ChrW(166)) = 1 Then
136 | sAuthValue = Mid(aAuths(j), Len(aURLs(i)) + 2)
137 | SaveSetting sRegistryDir, "Sources", "AUTH" & Format(i, "000"), sAuthValue
138 | End If
139 | Next j
140 | Next i
141 | End If
142 | If sFieldSets <> "" Then
143 | aFieldSets = Split(sFieldSets, "|")
144 | SaveSetting sRegistryDir, "FieldSets", "MAXALL", UBound(aFieldSets)
145 | For i = 0 To UBound(aFieldSets)
146 | aFieldList = Split(aFieldSets(i), ChrW(166))
147 | SaveSetting sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), aFieldList(0)
148 | SaveSetting sRegistryDir, "FieldSets", "MAX" & Format(i, "000"), UBound(aFieldList) - 1
149 | For j = 1 To UBound(aFieldList)
150 | SaveSetting sRegistryDir, "FieldSets", "FIELD" & Format(i, "000") & "-" & Format(j - 1, "000"), aFieldList(j)
151 | Next j
152 | Next i
153 | End If
154 | End Sub
155 |
156 | Function GetLatestVersionNumber()
157 | If oXMLHTTP Is Nothing Then
158 | Initialize
159 | End If
160 |
161 | sAPIUrl = Replace(sRepoURL, "github.com", "api.github.com/repos") & "/releases/latest"
162 | sTagLabel = "tag_name"
163 | With oXMLHTTP
164 | .Open "GET", sAPIUrl, True
165 | .Send
166 | Do While .readyState <> 4
167 | DoEvents
168 | Loop
169 | GetLatestVersionNumber = sVersion
170 | If .Status = 200 Then
171 | iTagStart = InStr(1, .responseText, sTagLabel)
172 | iTagStart = iTagStart + Len(sTagLabel & """:""")
173 | If iTagStart > 0 Then
174 | iTagEnd = InStr(iTagStart, .responseText, """")
175 | If iTagEnd > 0 Then
176 | GetLatestVersionNumber = Mid(.responseText, iTagStart, iTagEnd - iTagStart)
177 | End If
178 | End If
179 | End If
180 | End With
181 | End Function
182 |
183 | 'Main function called when toolbar button is pressed. Sets up dialog box.
184 | Sub LookupInterface(control As IRibbonControl)
185 | If Right(ActiveWorkbook.FullName, 4) = ".xls" Then
186 | iResult = MsgBox("File must be in XLSX format. Convert Now?", vbYesNo, "Question")
187 | If iResult = vbYes Then
188 | sXLSname = ActiveWorkbook.FullName
189 | sXLSXname = Replace(sXLSname, ".xls", ".xlsx")
190 | ActiveWorkbook.SaveAs Filename:=sXLSXname, FileFormat:=xlOpenXMLWorkbook
191 | Kill sXLSname
192 | Workbooks.Open sXLSXname
193 | Else
194 | Exit Sub
195 | End If
196 | End If
197 |
198 | If GetSetting(sRegistryDir, "General", "Version", "") = "" Then
199 | Initialize
200 | End If
201 |
202 | PopulateCombos
203 | RedrawButtons
204 |
205 | sFileName = ActiveWorkbook.Name
206 | sSheetName = ActiveSheet.Name
207 |
208 | LookupDialog.ResultColumnSpinner.Value = FindLastColumn() + 1
209 | sSourceRange = Selection.Address
210 | LookupDialog.LookupRange.Text = sSourceRange
211 | sSourceColumn = Split(Cells(1, Range(Selection.Address).Column).Address(True, False), "$")(0)
212 | LookupDialog.SearchValueBox.Value = "[[" & sSourceColumn & "]]"
213 |
214 | sLatestVersion = GetLatestVersionNumber
215 | If sLatestVersion = sVersion Then
216 | LookupDialog.VersionLabel.Caption = "You are using the latest version. (" & sVersion & ")"
217 | ElseIf StrComp(sLatestVersion, sVersion) < 0 Then
218 | LookupDialog.VersionLabel.Caption = "You are using a pre-release version. (" & sVersion & ")"
219 | Else
220 | LookupDialog.VersionLabel.Caption = "A newer version is available! (" & sLatestVersion & ")"
221 | End If
222 | LookupDialog.Show
223 | End Sub
224 |
225 | Sub AddURLtoRegistry(sURL)
226 | bFoundEmptySlot = False
227 | bDuplicate = False
228 | iMax = GetSetting(Catalog.sRegistryDir, "Sources", "MAX", -1)
229 | For i = 0 To iMax
230 | sRegURL = GetSetting(Catalog.sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), "")
231 | If sRegURL = "" Then
232 | bFoundEmptySlot = True
233 | SaveSetting Catalog.sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), sURL
234 | Exit For
235 | End If
236 | If sRegURL = sURL Then
237 | bDuplicate = True
238 | Exit Sub
239 | End If
240 | Next i
241 | If Not bFoundEmptySlot Then
242 | iMax = iMax + 1
243 | SaveSetting Catalog.sRegistryDir, "Sources", "MAX", iMax
244 | SaveSetting Catalog.sRegistryDir, "Sources", "SOURCE" & Format(iMax, "000"), sURL
245 | End If
246 | End Sub
247 |
248 | Sub RemoveURLfromRegistry(sURL)
249 | iMax = GetSetting(Catalog.sRegistryDir, "Sources", "MAX", -1)
250 | For i = 0 To iMax
251 | sRegURL = GetSetting(Catalog.sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), "")
252 | If sURL = sRegURL Then
253 | DeleteSetting Catalog.sRegistryDir, "Sources", "SOURCE" & Format(i, "000")
254 | If GetSetting(Catalog.sRegistryDir, "Sources", "AUTH" & Format(i, "000"), "") <> "" Then
255 | DeleteSetting Catalog.sRegistryDir, "Sources", "AUTH" & Format(i, "000")
256 | End If
257 | End If
258 | Next i
259 | End Sub
260 |
261 | Sub SaveCatalogAuthToRegistry()
262 | If GetSetting(sRegistryDir, "General", "Version", "NONE") = "NONE" Then
263 | Initialize
264 | End If
265 |
266 | sCatalogURL = LookupDialog.CatalogURLBox.Text
267 | AddURLtoRegistry (sCatalogURL)
268 | iMax = GetSetting(sRegistryDir, "Sources", "MAX", -1)
269 | For i = 0 To iMax
270 | sRegURL = GetSetting(sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), "")
271 | If sCatalogURL = sRegURL Then
272 | SaveSetting sRegistryDir, "Sources", "AUTH" & Format(i, "000"), sAuth
273 | End If
274 | Next i
275 | End Sub
276 |
277 | Sub ClearRegistryAuth(sURL)
278 | iMax = GetSetting(sRegistryDir, "Sources", "MAX", -1)
279 | For i = 0 To iMax
280 | sRegURL = GetSetting(sRegistryDir, "Sources", "SOURCE" & Format(i, "000"), "")
281 | If sURL = sRegURL Then
282 | sRegAuth = GetSetting(sRegistryDir, "Sources", "AUTH" & Format(i, "000"), "")
283 | If sRegAuth <> "" Then
284 | DeleteSetting Catalog.sRegistryDir, "Sources", "AUTH" & Format(i, "000")
285 | End If
286 | End If
287 | Next i
288 | End Sub
289 |
290 |
291 | Function SaveFieldSet(sSetName)
292 | SaveFieldSet = True
293 | If LookupDialog.ResultTypeList.ListCount = 0 Then
294 | MsgBox ("Please add at least one result type to the set")
295 | SaveFieldSet = False
296 | Else
297 | bFound = False
298 | iFoundIndex = -1
299 | iGapIndex = -1
300 | iMax = GetSetting(sRegistryDir, "FieldSets", "MAXALL", -1)
301 | For i = 0 To iMax
302 | sRegName = GetSetting(sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "")
303 | If Not bFound And sRegName = "" Then
304 | iGapIndex = i
305 | End If
306 | If Not bFound And sRegName = sSetName Then
307 | bFound = True
308 | iFoundIndex = i
309 | End If
310 | Next i
311 | If bFound Then
312 | iSetMax = GetSetting(sRegistryDir, "FieldSets", "MAX" & Format(iFoundIndex, "000"), -1)
313 | For i = 0 To iSetMax
314 | DeleteSetting sRegistryDir, "FieldSets", "FIELD" & Format(iFoundIndex, "000") & "-" & Format(i, "000")
315 | Next i
316 | Else
317 | If iGapIndex > -1 Then
318 | iFoundIndex = iGapIndex
319 | Else
320 | iFoundIndex = iMax + 1
321 | SaveSetting sRegistryDir, "FieldSets", "MAXALL", iFoundIndex
322 | End If
323 | SaveSetting sRegistryDir, "FieldSets", "NAME" & Format(iFoundIndex, "000"), sSetName
324 | End If
325 | iNewSetMax = LookupDialog.ResultTypeList.ListCount - 1
326 | SaveSetting sRegistryDir, "FieldSets", "MAX" & Format(iFoundIndex, "000"), iNewSetMax
327 | For i = 0 To iNewSetMax
328 | sNewField = LookupDialog.ResultTypeList.List(i)
329 | SaveSetting sRegistryDir, "FieldSets", "FIELD" & Format(iFoundIndex, "000") & "-" & Format(i, "000"), sNewField
330 | Next i
331 | End If
332 | End Function
333 |
334 | Sub DeleteFieldSet(sSetName)
335 | iMax = CInt(GetSetting(sRegistryDir, "FieldSets", "MAXALL", -1))
336 | For i = 0 To iMax
337 | sRegName = GetSetting(sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "")
338 | If sRegName = sSetName Then
339 | iSetMax = GetSetting(sRegistryDir, "FieldSets", "MAX" & Format(i, "000"), -1)
340 | For j = 0 To iSetMax
341 | If GetSetting(sRegistryDir, "FieldSets", "MAX" & Format(i, "000"), "NONE") <> "NONE" Then
342 | DeleteSetting sRegistryDir, "FieldSets", "FIELD" & Format(i, "000") & "-" & Format(j, "000")
343 | End If
344 | Next j
345 | If GetSetting(sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "NONE") <> "NONE" Then
346 | DeleteSetting sRegistryDir, "FieldSets", "NAME" & Format(i, "000")
347 | End If
348 | If GetSetting(sRegistryDir, "FieldSets", "MAX" & Format(i, "000"), "NONE") <> "NONE" Then
349 | DeleteSetting sRegistryDir, "FieldSets", "MAX" & Format(i, "000")
350 | End If
351 | If i = iMax Then
352 | SaveSetting sRegistryDir, "FieldSets", "MAXALL", i - 1
353 | End If
354 | End If
355 | Next i
356 | End Sub
357 |
358 | Function GetSourceRegIndex(sSource) As Integer
359 | GetSourceRegIndex = -1
360 | iURLsMax = GetSetting(sRegistryDir, "Sources", "MAX", 0)
361 | For i = 0 To iURLsMax
362 | sURL = GetSetting(sRegistryDir, "Sources", "SOURCE" & Format(i, "000"))
363 | If sURL = sSource Then
364 | GetSourceRegIndex = i
365 | End If
366 | Next i
367 | End Function
368 |
369 | Sub PopulateCombos()
370 | Dim sCatalogURL As String
371 |
372 | LookupDialog.CatalogURLBox.Clear
373 | iURLsMax = GetSetting(sRegistryDir, "Sources", "MAX", -1)
374 |
375 | For i = 0 To iURLsMax
376 | sURL = GetSetting(sRegistryDir, "Sources", "SOURCE" & Format(i, "000"))
377 | If sURL <> "" Then
378 | LookupDialog.CatalogURLBox.AddItem sURL
379 | End If
380 | Next i
381 |
382 | sSelected = GetSetting(sRegistryDir, "Sources", "SELECTED", "")
383 | iSelected = GetSourceRegIndex(sSelected)
384 | LookupDialog.CatalogURLBox.Value = sSelected
385 | sAuth = GetSetting(sRegistryDir, "Sources", "AUTH" & Format(iSelected, "000"), "")
386 |
387 | LookupDialog.FieldSetList.Clear
388 | iFieldSetsMax = GetSetting(sRegistryDir, "FieldSets", "MAXALL", 0)
389 | For i = 0 To iFieldSetsMax
390 | sName = GetSetting(sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "")
391 | If sName <> "" Then
392 | LookupDialog.FieldSetList.AddItem sName
393 | End If
394 | Next i
395 |
396 | LookupDialog.BooleanCombo.AddItem "AND"
397 | LookupDialog.BooleanCombo.AddItem "OR"
398 |
399 | Dim aOtherSources(4, 2) As Variant
400 | aOtherSources(0, 0) = "source:recap"
401 | aOtherSources(0, 1) = "ReCAP"
402 | aOtherSources(1, 0) = "source:borrowdirect"
403 | aOtherSources(1, 1) = "BorrowDirect (IPLC ReShare)"
404 | aOtherSources(2, 0) = "source:lccat"
405 | aOtherSources(2, 1) = "Library of Congress"
406 | aOtherSources(3, 0) = "source:worldcat"
407 | aOtherSources(3, 1) = "WorldCat"
408 |
409 | OtherSourcesDialog.OtherSourcesListBox.List = aOtherSources
410 |
411 | PopulateSourceDependentOptions
412 |
413 | End Sub
414 |
415 | Sub PopulateSourceDependentOptions()
416 | LookupDialog.ResultTypeCombo.Clear
417 | LookupDialog.ResultTypeCombo.AddItem "True/False"
418 | If Catalog.bIsAlma Then
419 | LookupDialog.ResultTypeCombo.AddItem "MMS ID"
420 | ElseIf LookupDialog.CatalogURLBox = "source:worldcat" Then
421 | LookupDialog.ResultTypeCombo.AddItem "OCLC No."
422 | Else
423 | LookupDialog.ResultTypeCombo.AddItem "Catalog ID"
424 | End If
425 | LookupDialog.ResultTypeCombo.AddItem "ISBN"
426 | If Not LookupDialog.CatalogURLBox = "source:worldcat" Then
427 | LookupDialog.ResultTypeCombo.AddItem "OCLC No."
428 | End If
429 | LookupDialog.ResultTypeCombo.AddItem "Title"
430 | If Not LookupDialog.CatalogURLBox = "source:recap" Then
431 | LookupDialog.ResultTypeCombo.AddItem "Language code"
432 | LookupDialog.ResultTypeCombo.AddItem "Leader"
433 | End If
434 | If Catalog.bIsAlma Then
435 | LookupDialog.ResultTypeCombo.AddItem "*Call No."
436 | LookupDialog.ResultTypeCombo.AddItem "*Location/DB Name"
437 | LookupDialog.ResultTypeCombo.AddItem "*Coverage"
438 | LookupDialog.ResultTypeCombo.AddItem "**Barcode"
439 | LookupDialog.ResultTypeCombo.AddItem "**Item Location"
440 | LookupDialog.ResultTypeCombo.AddItem "**Item Enum/Chron"
441 | LookupDialog.ResultTypeCombo.AddItem "**Shelf Locator"
442 | End If
443 |
444 | If LookupDialog.CatalogURLBox = "source:recap" Then
445 | LookupDialog.ResultTypeCombo.Style = 2 'fmStyleDropDownList
446 | LookupDialog.ResultTypeCombo.AddItem "LCCN"
447 | LookupDialog.ResultTypeCombo.AddItem "ReCAP Holdings"
448 | LookupDialog.ResultTypeCombo.AddItem "ReCAP CGD"
449 | Else
450 | LookupDialog.ResultTypeCombo.Style = 0 'fmStyleDropDownCombo
451 | End If
452 |
453 | If LookupDialog.CatalogURLBox = "source:borrowdirect" Then
454 | LookupDialog.ResultTypeCombo.AddItem "BorrowDirect Holdings"
455 | End If
456 |
457 | If LookupDialog.CatalogURLBox = "source:worldcat" Then
458 | LookupDialog.ResultTypeCombo.AddItem "WorldCat Holdings"
459 | LookupDialog.ResultTypeCombo.AddItem "Holdings Count"
460 | End If
461 |
462 | LookupDialog.SearchFieldCombo.Clear
463 |
464 | If Not bIsAlma Then
465 | LookupDialog.SearchFieldCombo.Style = 2 'fmStyleDropDownList
466 | LookupDialog.SearchFieldCombo.AddItem "Keywords"
467 | If LookupDialog.CatalogURLBox = "source:worldcat" Or LookupDialog.CatalogURLBox = "source:recap" Then
468 | LookupDialog.SearchFieldCombo.Enabled = True
469 | LookupDialog.SearchFieldCombo.AddItem "Title"
470 | LookupDialog.SearchFieldCombo.AddItem "ISBN"
471 | If LookupDialog.CatalogURLBox = "source:recap" Then
472 | LookupDialog.SearchFieldCombo.AddItem "LCCN"
473 | Else
474 | LookupDialog.SearchFieldCombo.AddItem "ISSN"
475 | LookupDialog.SearchFieldCombo.AddItem "Z-Title-Date"
476 | LookupDialog.SearchFieldCombo.AddItem "Z-Author-Title-Date"
477 | End If
478 | LookupDialog.SearchFieldCombo.AddItem "OCLC No."
479 |
480 | Else
481 | LookupDialog.SearchFieldCombo.Enabled = False
482 | End If
483 | LookupDialog.BooleanCombo.Enabled = False
484 | LookupDialog.BooleanCombo.Value = ""
485 | LookupDialog.OperatorCombo.Enabled = False
486 | LookupDialog.OperatorCombo.Value = "="
487 | LookupDialog.SearchValueBox.Enabled = False
488 | LookupDialog.SearchListBox.Clear
489 | LookupDialog.SearchListBox.Enabled = False
490 | sSourceColumn = Split(Cells(1, Range(Selection.Address).Column).Address(True, False), "$")(0)
491 | LookupDialog.SearchValueBox.Value = "[[" & sSourceColumn & "]]"
492 | Else
493 | LookupDialog.SearchFieldCombo.Style = 0 'fmStyleDropDownCombo
494 | LookupDialog.SearchFieldCombo.Clear
495 | LookupDialog.SearchFieldCombo.Enabled = True
496 | ReDim aAlmaSearchKeys(7, 2) As Variant
497 | aAlmaSearchKeys(0, 0) = "Keywords"
498 | aAlmaSearchKeys(0, 1) = "alma.all_for_ui"
499 | aAlmaSearchKeys(1, 0) = "Call No."
500 | aAlmaSearchKeys(1, 1) = "alma.PermanentCallNumber"
501 | aAlmaSearchKeys(2, 0) = "Title"
502 | aAlmaSearchKeys(2, 1) = "alma.title"
503 | aAlmaSearchKeys(3, 0) = "ISBN"
504 | aAlmaSearchKeys(3, 1) = "alma.isbn"
505 | aAlmaSearchKeys(4, 0) = "ISSN"
506 | aAlmaSearchKeys(4, 1) = "alma.issn"
507 | aAlmaSearchKeys(5, 0) = "MMS ID"
508 | aAlmaSearchKeys(5, 1) = "rec.id"
509 | aAlmaSearchKeys(6, 0) = "Barcode"
510 | aAlmaSearchKeys(6, 1) = "alma.barcode"
511 | For i = 0 To UBound(aAlmaSearchKeys) - 1
512 | LookupDialog.SearchFieldCombo.AddItem aAlmaSearchKeys(i, 0)
513 | Next i
514 | LookupDialog.SearchFieldCombo.AddItem "Other fields..."
515 | LookupDialog.SearchFieldCombo.ListIndex = 0
516 |
517 | LookupDialog.BooleanCombo.Enabled = True
518 | LookupDialog.OperatorCombo.Enabled = True
519 | LookupDialog.SearchValueBox.Enabled = True
520 | LookupDialog.SearchListBox.Enabled = True
521 |
522 | PopulateOperatorCombo
523 | End If
524 | If LookupDialog.SearchFieldCombo.ListCount > 0 Then
525 | LookupDialog.SearchFieldCombo.ListIndex = 0
526 | End If
527 | LookupDialog.ResultTypeCombo.ListIndex = 0
528 |
529 | End Sub
530 |
531 | Sub PopulateOperatorCombo()
532 | If Not bIsAlma Then
533 | Exit Sub
534 | End If
535 | LookupDialog.OperatorCombo.Clear
536 | sKey = GetAlmaSearchKey(LookupDialog.SearchFieldCombo.Value)
537 | bFound = False
538 | If IsEmpty(aExplainFields) Then
539 | aExplainFields = GetAllFields()
540 | End If
541 | If UBound(aExplainFields) = 0 Then
542 | LookupDialog.OperatorCombo.Enabled = False
543 | Exit Sub
544 | End If
545 | sDefaultValue = "="
546 | For i = 0 To UBound(aExplainFields)
547 | If sKey = aExplainFields(i, 1) Then
548 | aOperators = aExplainFields(i, 2)
549 | For j = 0 To UBound(aOperators)
550 | sOperator = aOperators(j)
551 | If sOperator = "" Then
552 | sOperator = "empty"
553 | End If
554 | LookupDialog.OperatorCombo.AddItem sOperator
555 | Next j
556 | bFound = True
557 | End If
558 | If bFound Then
559 | Exit For
560 | End If
561 | Next i
562 | If bFound Then
563 | LookupDialog.OperatorCombo.Value = sDefaultValue
564 | Else
565 | MsgBox ("Search field not set to a valid index name")
566 | LookupDialog.SearchFieldCombo.Value = "Keywords"
567 | PopulateOperatorCombo
568 | End If
569 | End Sub
570 |
571 | Function GetAlmaSearchKey(sPhrase As String) As String
572 | sKey = sPhrase
573 | For i = 0 To UBound(aAlmaSearchKeys)
574 | If sPhrase = aAlmaSearchKeys(i, 0) Then
575 | sKey = aAlmaSearchKeys(i, 1)
576 | End If
577 | Next i
578 | GetAlmaSearchKey = sKey
579 | End Function
580 |
581 | Sub RedrawButtons()
582 | With LookupDialog
583 | .ResultTypeList.Enabled = True
584 | .ResultTypeCombo.Style = fmStyleDropDownCombo
585 | .AddResultButton.Enabled = True
586 | If .ResultTypeList.ListCount > 0 And .ResultTypeList.ListIndex > -1 Then
587 | .RemoveResultButton.Enabled = True
588 | If .ResultTypeList.ListIndex > 0 Then
589 | .MoveUpButton.Enabled = True
590 | Else
591 | .MoveUpButton.Enabled = False
592 | End If
593 | If .ResultTypeList.ListIndex < .ResultTypeList.ListCount - 1 Then
594 | .MoveDownButton.Enabled = True
595 | Else
596 | .MoveDownButton.Enabled = False
597 | End If
598 | Else
599 | .RemoveResultButton.Enabled = False
600 | .MoveUpButton.Enabled = False
601 | .MoveDownButton.Enabled = False
602 | End If
603 | .NewSetButton.Enabled = True
604 | If .FieldSetList.ListCount > 0 And .FieldSetList.ListIndex > -1 Then
605 | .SaveSetButton.Enabled = True
606 | .LoadSetButton.Enabled = True
607 | .DeleteSetButton.Enabled = True
608 | Else
609 | .SaveSetButton.Enabled = False
610 | .LoadSetButton.Enabled = False
611 | .DeleteSetButton.Enabled = False
612 | End If
613 | End With
614 | End Sub
615 |
616 | 'Determine the rightmost column containing data
617 | Function FindLastColumn() As Integer
618 | Dim LastColumn As Integer
619 | If WorksheetFunction.CountA(Cells) > 0 Then
620 | 'Search for any entry, by searching backwards by Columns.
621 | LastColumn = Cells.Find(What:="*", After:=[A1], _
622 | SearchOrder:=xlByColumns, _
623 | SearchDirection:=xlPrevious).Column
624 | FindLastColumn = LastColumn
625 | End If
626 | End Function
627 |
628 | 'Converts a number to an Excel column index (A,B,C,....AA,AB, etc.)
629 | Function ColumnLetterConvert(sInput As String) As String
630 | iVal = val(sInput)
631 | If iVal > 0 Then
632 | If iVal > 26 Then
633 | ColumnLetterConvert = Chr(Int((iVal - 1) / 26) + 64) & Chr(((iVal - 1) Mod 26) + 65)
634 | Else
635 | ColumnLetterConvert = Chr(iVal + 64)
636 | End If
637 | Else
638 | ColumnLetterConvert = "A"
639 | End If
640 | End Function
641 |
642 | Function EncodeURI(ByVal sStr As String) As String
643 |
644 | Dim i As Long
645 | Dim a As Long
646 | Dim res As String
647 | Dim code As String
648 |
649 | res = ""
650 | For i = 1 To Len(sStr)
651 | a = AscW(Mid(sStr, i, 1)) And &HFFFF&
652 | Select Case a
653 | Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
654 | code = Mid(sStr, i, 1)
655 | Case 32
656 | code = "%20" '"+"
657 | Case 0 To 127
658 | code = EncodeByte(CInt(a))
659 | Case 128 To 2047
660 | code = EncodeByte(((a \ 64) Or 192))
661 | code = code & EncodeByte(((a And 63) Or 128))
662 | Case Else
663 | code = EncodeByte(((a \ 4096) Or 224))
664 | code = code & EncodeByte((((a \ 64) And 63) Or 128))
665 | code = code & EncodeByte(((a And 63) Or 128))
666 | End Select
667 | res = res & code
668 | Next i
669 | EncodeURI = res
670 | End Function
671 |
672 | ''=============================================================
673 | '' URL encode single byte
674 | ''=============================================================
675 | Private Function EncodeByte(val As Integer) As String
676 | Dim res As String
677 | res = "%" & Right("0" & Hex(val), 2)
678 | EncodeByte = res
679 | End Function
680 |
681 | Function ConstructURL(sBaseURL As String, sQuery1 As String, sSearchType As String, bAdvancedSearch As Boolean, oQueryRow As Range) As String
682 | sURL = sBaseURL & "?operation=searchRetrieve&version=1.2&maximumRecords=" & iMaximumRecords & "&query="
683 |
684 | iSearchTermsCount = 1
685 | If bAdvancedSearch Then
686 | iSearchTermsCount = LookupDialog.SearchListBox.ListCount
687 | End If
688 |
689 | Dim aSearchTerms() As Variant
690 | ReDim aSearchTerms(iSearchTermsCount, 4)
691 |
692 | Dim sIndex As String
693 |
694 | If Not bAdvancedSearch Then
695 | sIndex = GetAlmaSearchKey(sSearchType)
696 | aSearchTerms(0, 0) = ""
697 | aSearchTerms(0, 1) = sSearchType
698 | aSearchTerms(0, 2) = LookupDialog.OperatorCombo.Value
699 | If sSearchType = "alma.PermanentCallNumber" Then
700 | aSearchTerms(0, 2) = "all"
701 | End If
702 | aSearchTerms(0, 3) = sQuery1
703 | Else
704 | With LookupDialog.SearchListBox
705 | For i = 0 To iSearchTermsCount - 1
706 | aSearchTerms(i, 0) = .List(i, 0)
707 | aSearchTerms(i, 1) = .List(i, 1)
708 | aSearchTerms(i, 2) = .List(i, 2)
709 | aSearchTerms(i, 3) = .List(i, 3)
710 | Next i
711 | End With
712 | End If
713 |
714 | For i = 0 To UBound(aSearchTerms) - 1
715 | sBoolean = aSearchTerms(i, 0)
716 | sIndex = aSearchTerms(i, 1)
717 | sIndex = GetAlmaSearchKey(sIndex)
718 | sOperator = aSearchTerms(i, 2)
719 | Dim sQuery As String
720 | sQuery = CStr(aSearchTerms(i, 3))
721 | sQuery = GetColumnContents(oQueryRow, sQuery)
722 | sQuery = Replace(sQuery, "http://", "")
723 | sQuery = Replace(sQuery, "-", " ")
724 | sQuery = Replace(sQuery, "_", " ")
725 | If Trim(sQuery) = "" Then
726 | GoTo NextTerm
727 | End If
728 | If sBoolean <> "" Then
729 | sURL = sURL & "+" & sBoolean & "+"
730 | End If
731 | Select Case sIndex
732 | Case "alma.isbn"
733 | sQuery = NormalizeISBN(sQuery)
734 | If sQuery = "" Then
735 | sQuery = "FALSE"
736 | End If
737 | Case "alma.issn"
738 | sQuery = NormalizeISSN(sQuery)
739 | If sQuery = "" Then
740 | sQuery = "FALSE"
741 | End If
742 | Case "alma.barcode"
743 | sQuery = Replace(sQuery, " ", "")
744 | End Select
745 | Do While (InStr(1, sQuery, "||") > 0) Or (InStr(1, sQuery, "%7C%7C") > 0)
746 | sQuery = Replace(sQuery, "||", "|")
747 | sQuery = Replace(sQuery, "%7C%7C", "%7C")
748 | Loop
749 | If Right(sQuery, 1) = "|" Then
750 | sQuery = Left(sQuery, Len(sQuery) - 1)
751 | End If
752 | If Right(sQuery, 3) = "%7C" Then
753 | sQuery = Left(sQuery, Len(sQuery) - 3)
754 | End If
755 | If InStr(1, sQuery, "|") Or InStr(1, sQuery, "%7C") Then
756 | sQuery = Replace(sQuery, "|", "%22+OR+" & sIndex & "+" & sOperator & "+%22")
757 | sQuery = Replace(sQuery, "%7C", "%22+OR+" & sIndex & "+" & sOperator & "+%22")
758 | sURL = sURL & "(+" & sIndex & "+" & sOperator & "+%22" + EncodeURI(sQuery) + "%22+)"
759 | Else
760 | If sOperator = "empty" Then
761 | sURL = sURL & sIndex & "+==+%22%22"
762 | Else
763 | sURL = sURL & sIndex & "+" & sOperator & "+%22" + EncodeURI(sQuery) + "%22"
764 | End If
765 | End If
766 | NextTerm:
767 | Next i
768 | If Not LookupDialog.IncludeSuppressed Then
769 | sURL = sURL & "+AND+alma.mms_tagSuppressed=false"
770 | End If
771 | Debug.Print sURL
772 | ConstructURL = sURL
773 | End Function
774 |
775 |
776 | Function GenerateAuth(sUsername As String, sPassword As String)
777 | Set oB64Obj = CreateObject("MSXML2.DOMDocument")
778 | Set oB64Node = oB64Obj.createElement("b64")
779 | oB64Node.DataType = "bin.base64"
780 | sUserPass = sUsername & ":" & sPassword
781 | Dim yUserPassBytes() As Byte
782 | yUserPassBytes = StrConv(sUserPass, vbFromUnicode)
783 | oB64Node.nodeTypedValue = yUserPassBytes
784 | GenerateAuth = oB64Node.Text
785 | End Function
786 |
787 | Function DecodeAuth() As String
788 | DecodeAuth = ""
789 | If sAuth <> "" Then
790 | Set oB64Obj = CreateObject("MSXML2.DOMDocument")
791 | Set oB64Node = oB64Obj.createElement("b64")
792 | oB64Node.DataType = "bin.base64"
793 | oB64Node.Text = sAuth
794 | DecodeAuth = StrConv(oB64Node.nodeTypedValue, vbUnicode)
795 | End If
796 | End Function
797 |
798 | Function GetAllFields()
799 | If oXMLHTTP Is Nothing Then
800 | Initialize
801 | End If
802 | Dim sCatalogURL As String
803 | sCatalogURL = CStr(LookupDialog.CatalogURLBox.Text)
804 | bInvalidURL = False
805 | If Left(sCatalogURL, 4) <> "http" Then
806 | invalidURL = True
807 | End If
808 | bKeepTryingURL = True
809 | bNeedsAuthentication = False
810 | bIsoholdEnabled = False
811 | If Not bInvalidURL Then
812 | While bKeepTryingURL
813 | bInvalidURL = False
814 | sExplainURL = sCatalogURL & "?version=1.2&operation=explain"
815 | With oXMLHTTP
816 | .Open "GET", sExplainURL, True
817 | .setRequestHeader "Cache-Control", "no-cache,max-age=0"
818 | .setRequestHeader "pragma", "no-cache"
819 | If sAuth <> "" Then
820 | .setRequestHeader "Authorization", "Basic " + sAuth
821 | End If
822 | .Send
823 |
824 | Do While .readyState <> 4
825 | DoEvents
826 | Loop
827 |
828 | sResponse = .responseText
829 | bKeepTryingURL = False
830 | If .Status <> 200 Or InStr(sResponse, "explainResponse") = 0 Then
831 | bInvalidURL = True
832 | End If
833 | If .Status = 401 Then
834 | bNeedsAuthentication = True
835 | bKeepTryingURL = True
836 | bInvalidURL = True
837 | UserPassForm.UserNameBox.Value = ""
838 | UserPassForm.PasswordBox.Value = ""
839 | UserPassForm.Show
840 | If bKeepTryingURL Then
841 | sAuth = GenerateAuth(UserPassForm.UserNameBox.Value, UserPassForm.PasswordBox.Value)
842 | End If
843 | End If
844 | If .Status = 200 And sAuth <> "" And UserPassForm.RememberCheckbox.Value Then
845 | SaveCatalogAuthToRegistry
846 | End If
847 | End With
848 | Wend
849 | End If
850 | If bInvalidURL Then
851 | If bNeedsAuthentication Then
852 | MsgBox ("Cannot log in to catalog.")
853 | Else
854 | MsgBox ("Cannot access catalog. Please confirm the Alma URL is correct.")
855 | End If
856 | GetAllFields = Null
857 | Exit Function
858 | End If
859 | 'Check if ISO Holdings are enabled
860 | sExplainURL = sExplainURL & "&recordSchema=isohold"
861 | With oXMLHTTP
862 | .Open "GET", sExplainURL, True
863 | If sAuth <> "" Then
864 | .setRequestHeader "Authorization", "Basic " + sAuth
865 | End If
866 | .Send
867 |
868 | Do While .readyState <> 4
869 | DoEvents
870 | Loop
871 | If .Status = 200 Then
872 | bIsoholdEnabled = True
873 | End If
874 |
875 | End With
876 |
877 |
878 | oXMLDOM.SetProperty "SelectionNamespaces", "xmlns:xr='http://www.loc.gov/zing/srw/' " & _
879 | "xmlns:xpl='http://explain.z3950.org/dtd/2.0/' " & _
880 | "xmlns:ns='http://explain.z3950.org/dtd/2.1/'"
881 | oXMLDOM.LoadXML (sResponse)
882 | sFields = ""
883 | Set aFields = oXMLDOM.SelectNodes("xr:explainResponse/xr:record/xr:recordData/" & _
884 | "xpl:explain/xpl:indexInfo/xpl:index")
885 | Dim aFieldMap() As Variant
886 | ReDim aFieldMap(aFields.length - 1, 2)
887 | For i = 0 To aFields.length - 1
888 | sLabel = aFields(i).SelectSingleNode("ns:title").Text
889 | sIndexCode = aFields(i).SelectSingleNode("xpl:map/xpl:name").Text
890 | sIndexSet = aFields(i).SelectSingleNode("xpl:map/xpl:name/@set").Text
891 | Dim oOperatorGroup As Variant
892 | Set oOperatorGroup = aFields(i).SelectNodes("xpl:configInfo/xpl:supports")
893 | Dim aOperators() As String
894 | ReDim aOperators(oOperatorGroup.length - 1)
895 | For j = 0 To oOperatorGroup.length - 1
896 | aOperators(j) = oOperatorGroup.Item(j).Text
897 | Next j
898 |
899 | aFieldMap(i, 0) = sLabel
900 | aFieldMap(i, 1) = sIndexSet & "." & sIndexCode
901 | aFieldMap(i, 2) = aOperators
902 | Next i
903 |
904 | For i = 0 To UBound(aFieldMap)
905 | For j = i + 1 To UBound(aFieldMap)
906 | SearchI = Replace(UCase(aFieldMap(i, 0)), "(", "")
907 | SearchJ = Replace(UCase(aFieldMap(j, 0)), "(", "")
908 | If UCase(SearchI > SearchJ) Then
909 | t1 = aFieldMap(j, 0)
910 | t2 = aFieldMap(j, 1)
911 | t3 = aFieldMap(j, 2)
912 | aFieldMap(j, 0) = aFieldMap(i, 0)
913 | aFieldMap(j, 1) = aFieldMap(i, 1)
914 | aFieldMap(j, 2) = aFieldMap(i, 2)
915 | aFieldMap(i, 0) = t1
916 | aFieldMap(i, 1) = t2
917 | aFieldMap(i, 2) = t3
918 | End If
919 | Next j
920 | Next i
921 | GetAllFields = aFieldMap
922 | End Function
923 |
924 | Function Z3950Connect(sSource As String) As Boolean
925 | bKeepTryingURL = True
926 | sZHost = ""
927 | sZPort = ""
928 | sZDB = ""
929 | sZUserName = ""
930 | sZPassword = ""
931 | If sSource = "source:worldcat" Then
932 | sZHost = sWCZhost
933 | sZPort = 210
934 | sZDB = sWCZDB
935 | End If
936 |
937 | sUserPass = DecodeAuth()
938 | iDelimPos = InStr(1, sUserPass, ":")
939 | If iDelimPos > 0 Then
940 | sZUserName = Left(sUserPass, iDelimPos - 1)
941 | sZPassword = Mid(sUserPass, iDelimPos + 1)
942 | End If
943 |
944 | bValidConnection = False
945 | While bKeepTryingURL And Not bValidConnection
946 | oZConn = ZOOM_connection_create(0)
947 | ZOOM_connection_option_set oZConn, "databaseName", sZDB
948 | ZOOM_connection_option_set oZConn, "preferredRecordSyntax", "USmarc"
949 | ZOOM_connection_option_set oZConn, "elementSetName", "FA"
950 | ZOOM_connection_option_set oZConn, "largeSetLowerBound", "10000"
951 | ZOOM_connection_option_set oZConn, "user", sZUserName
952 | ZOOM_connection_option_set oZConn, "password", sZPassword
953 | ZOOM_connection_connect oZConn, sZHost, sZPort
954 | errcode = ZOOM_connection_errcode(oZConn)
955 | If errcode > 0 And bKeepTryingURL Then
956 | UserPassForm.Show
957 | sZUserName = UserPassForm.UserNameBox.Value
958 | sZPassword = UserPassForm.PasswordBox.Value
959 | ZOOM_connection_destroy (oZConn)
960 | oZConn = 0
961 | Else
962 | bValidConnection = True
963 | If sZUserName <> "" And sZPassword <> "" And UserPassForm.RememberCheckbox Then
964 | sAuth = GenerateAuth(UserPassForm.UserNameBox.Value, UserPassForm.PasswordBox.Value)
965 | SaveCatalogAuthToRegistry
966 | End If
967 | End If
968 | Wend
969 |
970 | If Not bValidConnection Then
971 | Z3950Connect = False
972 | MsgBox ("Cannot connect to catalog.")
973 | ZOOM_connection_destroy (oZConn)
974 | oZConn = 0
975 | Exit Function
976 | End If
977 | Z3950Connect = True
978 | End Function
979 |
980 | Function Z3950Search(sQuery As String, sSearchType As String, sSource As String)
981 | If oZConn = 0 Then
982 | bSuccess = Z3950Connect(sSource)
983 | If Not bSuccess Then
984 | Z3950Search = ""
985 | Exit Function
986 | End If
987 | End If
988 |
989 | oConverter.Open
990 | oConverter.Charset = "UTF-8"
991 | oConverter.Type = 2
992 | oConverter.WriteText sQuery
993 | oConverter.Position = 0
994 | oConverter.Charset = "ISO-8859-1"
995 | sQuery = oConverter.ReadText
996 | sQuery = Replace(sQuery, ChrW(239) & ChrW(187) & ChrW(191), "") 'BOM
997 | oConverter.Close
998 |
999 | sSearchIndex = "1016"
1000 | If sSearchType = "Title" Then
1001 | sSearchIndex = "4"
1002 | ElseIf sSearchType = "ISBN" Then
1003 | sSearchIndex = "7"
1004 | sQuery = NormalizeISBN(sQuery)
1005 | ElseIf sSearchType = "ISSN" Then
1006 | sSearchIndex = "8"
1007 | sQuery = NormalizeISSN(sQuery)
1008 | ElseIf sSearchType = "OCLC No." Then
1009 | sSearchIndex = "12"
1010 | sQuery = NormalizeOCLC(sQuery)
1011 | End If
1012 |
1013 | sQuery = Replace(sQuery, """", "\""")
1014 |
1015 | sCQLQuery = ""
1016 | If sSearchType = "Z-Author-Title-Date" Then
1017 | oRegEx.Pattern = "^AUTHOR *= *(.*) AND TITLE *= *(.*) AND YEAR *= *(.*)"
1018 | If oRegEx.Test(sQuery) Then
1019 | Set oFields = oRegEx.Execute(sQuery)
1020 | sAuthor = oFields(0).Submatches(0)
1021 | sAuthor = Replace(sAuthor, "*", "?")
1022 | sTitle = oFields(0).Submatches(1)
1023 | sTitle = Replace(sTitle, "*", "?")
1024 | sYear = oFields(0).Submatches(2)
1025 | sCQLQuery = "@and @attr 1=31 " & sYear & " @and " & _
1026 | "@attr 1=1 @attr 3=1 @attr 4=1 """ & sAuthor & """ " & _
1027 | "@attr 1=4 @attr 3=1 @attr 4=1 """ & sTitle & """"
1028 | Else
1029 | sCQLQuery = "@attr 4=1 @attr 1=1016 " & sQuery
1030 | End If
1031 | ElseIf sSearchType = "Z-Title-Date" Then
1032 | oRegEx.Pattern = "^TITLE *= *(.*) AND YEAR *= *(.*)"
1033 | If oRegEx.Test(sQuery) Then
1034 | Set oFields = oRegEx.Execute(sQuery)
1035 | sTitle = oFields(0).Submatches(0)
1036 | sTitle = Replace(sTitle, "*", "?")
1037 | sYear = oFields(0).Submatches(1)
1038 | sCQLQuery = "@and @attr 1=31 " & sYear & " " & _
1039 | "@attr 1=4 @attr 3=1 @attr 4=1 """ & sTitle & """"
1040 | Else
1041 | sCQLQuery = "@attr 4=1 @attr 1=1016 " & sQuery
1042 | End If
1043 | Else
1044 | aSearchKeys = Split(sQuery, "|")
1045 | For i = 0 To UBound(aSearchKeys)
1046 | If sCQLQuery <> "" Then
1047 | sCQLQuery = "@or " & sCQLQuery
1048 | End If
1049 | sCQLQuery = sCQLQuery & "@attr 4=1 @attr 1=" & sSearchIndex & " """ & aSearchKeys(i) & """"
1050 | Next i
1051 | End If
1052 | Debug.Print sCQLQuery
1053 |
1054 | zrs = ZOOM_connection_search_pqf(oZConn, sCQLQuery)
1055 | ZOOM_resultset_option_set zrs, "count", iMaximumRecords
1056 | zcount = ZOOM_resultset_size(zrs)
1057 | If zcount > 0 Then
1058 | sAllRecords = ""
1059 | If zcount > iMaximumRecords Then
1060 | zcount = iMaximumRecords
1061 | End If
1062 | For i = 0 To zcount - 1
1063 | zrec = ZOOM_resultset_record(zrs, i)
1064 | Dim zptr As LongPtr
1065 | Dim zsize As Long
1066 | zptr = ZOOM_record_get(zrec, "xml;charset=marc8,utf8", zsize)
1067 | Dim recBytes() As Byte
1068 | ReDim recBytes(zsize)
1069 | CopyMemory recBytes(0), ByVal zptr, zsize
1070 | If zsize > 0 Then
1071 | ReDim Preserve recBytes(zsize - 1) 'remove null terminator
1072 | End If
1073 | sResultXML = StrConv(recBytes, vbUnicode)
1074 | oConverter.Open
1075 | oConverter.Type = 1
1076 | oConverter.Write recBytes
1077 | oConverter.Position = 0
1078 | oConverter.Type = 2
1079 | oConverter.Charset = "UTF-8"
1080 | sResultXML = oConverter.ReadText
1081 | oConverter.Close
1082 |
1083 | sResultXML = Replace(sResultXML, "", "")
1085 | sResultXML = Replace(sResultXML, Chr(10), "")
1086 | sAllRecords = sAllRecords & sResultXML
1087 | Next i
1088 | sAllRecords = sAllRecords & ""
1089 | End If
1090 | Z3950Search = sAllRecords
1091 | 'ZOOM_resultset_destroy (zrs)
1092 | End Function
1093 |
1094 | Function GetColumnContents(ByVal oRow As Range, sValue As String) As String
1095 | oRegEx.Pattern = "^\[\[[A-Z]+\]\]$"
1096 | If oRegEx.Test(sValue) Then
1097 | sValue = Replace(sValue, "[[", "")
1098 | sValue = Replace(sValue, "]]", "")
1099 | sValue = CStr(oRow.Cells(1, Cells(1, sValue).Column).Value)
1100 | End If
1101 | sValue = Replace(sValue, ChrW(160), " ")
1102 | sValue = Replace(sValue, ChrW(166), "|")
1103 | sValue = Trim(sValue)
1104 | GetColumnContents = sValue
1105 | End Function
1106 |
1107 | Function Lookup(ByVal sQueryRow As Range, sCatalogURL As String) As String
1108 | If oXMLHTTP Is Nothing Then
1109 | Initialize
1110 | End If
1111 |
1112 | Dim bAdvancedSearch As Boolean
1113 | bAdvancedSearch = False
1114 | If bIsAlma And LookupDialog.SearchListBox.ListCount > 0 Then
1115 | bAdvancedSearch = True
1116 | End If
1117 |
1118 | Dim sQuery1 As String
1119 | sQuery1 = ""
1120 |
1121 | If Not bAdvancedSearch Then
1122 | Dim sSearchString As String
1123 | sSearchString = GetColumnContents(sQueryRow, LookupDialog.SearchValueBox.Value)
1124 | If sSearchString = "FALSE" Or sSearchString = "" Then
1125 | Lookup = ""
1126 | Exit Function
1127 | End If
1128 | sQuery1 = sSearchString
1129 | End If
1130 |
1131 | Dim sSearchType As String
1132 | sSearchType = CStr(LookupDialog.SearchFieldCombo.Value)
1133 | Dim sFormat As String
1134 | sURL = ""
1135 |
1136 | If LookupDialog.ValidateCheckBox.Value And Not bAdvancedSearch Then
1137 | If sSearchType = "ISBN" Then
1138 | Dim sISBN As String
1139 | sISBN = NormalizeISBN(sQuery1)
1140 | iVbarPos = InStr(1, sISBN, "|")
1141 | If iVbarPos > 0 Then
1142 | sISBN = Left(sISBN, iVbarPos - 1)
1143 | End If
1144 | If sISBN = "INVALID" Or sISBN <> GenerateCheckDigit(sISBN) Then
1145 | Lookup = "INVALID"
1146 | Exit Function
1147 | End If
1148 | ElseIf sSearchType = "ISSN" Then
1149 | Dim sISSN As String
1150 | sISSN = NormalizeISSN(sQuery1)
1151 | If sISSN = "INVALID" Or sISSN <> GenerateCheckDigit(sISSN) Then
1152 | Lookup = "INVALID"
1153 | Exit Function
1154 | End If
1155 | End If
1156 | End If
1157 |
1158 | If sCatalogURL = "source:recap" Then
1159 | Select Case sSearchType
1160 | Case "ISBN"
1161 | sQuery1 = "isbn_s:" & Replace(NormalizeISBN(sQuery1), "|", "+OR+")
1162 | Case "Title"
1163 | sQuery1 = "%22" & EncodeURI(sQuery1) & "%22&search_field=title"
1164 | Case "OCLC No."
1165 | sQuery1 = "oclc_s:" & Replace(NormalizeOCLC(sQuery1), "|", "+OR+")
1166 | Case "LCCN"
1167 | sQuery1 = "lccn_s:" & Replace(sQuery1, "|", "+OR+")
1168 | Case Else
1169 | sQuery1 = "%22" & EncodeURI(sQuery1) & "%22"
1170 | End Select
1171 | sQuery1 = sQuery1 & "&per_page=" & iMaximumRecords
1172 | If sQuery1 = "" Then
1173 | sQuery1 = False
1174 | Else 'Throttle ReCAP queries to one per second
1175 | Application.Wait (Now() + TimeValue("0:00:01"))
1176 | End If
1177 | sURL = sBlacklightURL & sQuery1
1178 | ElseIf sCatalogURL = "source:borrowdirect" Then
1179 | sURL = sIPLCReshareURL & "%22" & EncodeURI(sQuery1) & "%22&limit=" & iMaximumRecords
1180 | ElseIf sCatalogURL = "source:lccat" Then
1181 | sURL = sLCCatURL & "?version=1.1&operation=searchRetrieve" & _
1182 | "&maximumRecords=" & iMaximumRecords & "&recordSchema=marcxml&query=%22" & sQuery1 & "%22"
1183 | ElseIf sCatalogURL = "source:worldcat" Then
1184 | sURL = "z3950"
1185 | Else
1186 | sURL = ConstructURL(sCatalogURL, sQuery1, sSearchType, bAdvancedSearch, sQueryRow)
1187 | End If
1188 | sHoldingsURL = Replace(sURL, "&query", "&recordSchema=isohold&query")
1189 | sResponse = ""
1190 |
1191 | If sURL = "z3950" Then
1192 | sResponse = Z3950Search(sQuery1, sSearchType, sCatalogURL)
1193 | Else
1194 | With oXMLHTTP
1195 | .Open "GET", sURL, True
1196 | If sAuth <> "" Then
1197 | .setRequestHeader "Authorization", "Basic " + sAuth
1198 | End If
1199 | .Send
1200 | Do While .readyState <> 4
1201 | DoEvents
1202 | Loop
1203 | sResponse = .responseText
1204 | sHoldings = ""
1205 | If sCatalogURL = "source:borrowdirect" Then
1206 | sAllRecords = ""
1207 | iXMLstart = InStr(1, sResponse, " 0
1209 | If iXMLstart < 1 Then
1210 | sResponse = ""
1211 | Else
1212 | sResponse = Mid(sResponse, iXMLstart)
1213 | iXMLend = InStr(1, sResponse, "<\/collection>")
1214 | sThisRecord = Left(sResponse, iXMLend - 1)
1215 | sResponse = Mid(sResponse, iXMLend)
1216 | sThisRecord = Replace(sThisRecord, "", _
1217 | "")
1218 | sThisRecord = Replace(sThisRecord, "<\/record>", "<\/record><\/recordData><\/record>")
1219 | sThisRecord = Replace(sThisRecord, "\n", "")
1220 | sThisRecord = Replace(sThisRecord, "\""", """")
1221 | sThisRecord = Replace(sThisRecord, "\/", "/")
1222 | sAllRecords = sAllRecords & sThisRecord
1223 | End If
1224 | iXMLstart = InStr(1, sResponse, ""
1227 | sResponse = sAllRecords
1228 | End If
1229 | If bIsoholdEnabled Then
1230 | .Open "GET", sHoldingsURL, True
1231 | If sAuth <> "" Then
1232 | .setRequestHeader "Authorization", "Basic " + sAuth
1233 | End If
1234 | .Send
1235 | Do While .readyState <> 4
1236 | DoEvents
1237 | Loop
1238 | sHoldings = .responseText
1239 | If InStr(1, sHoldings, "searchRetrieveResponse") = 0 Then
1240 | bIsoholdEnabled = False
1241 | End If
1242 | End If
1243 | End With
1244 | End If
1245 | Lookup = sResponse & sHoldings
1246 | End Function
1247 |
1248 | Function ExtractField(sResultTypeAll As String, sResultXML As String, bHoldings As Boolean, Optional sBarcode As Variant) As String
1249 | aResultFields = Split(sResultTypeAll, "|", -1, 0)
1250 | iResultTypes = UBound(aResultFields)
1251 | sBasePath = ""
1252 | If bHoldings Then
1253 | oXMLDOM.SetProperty "SelectionNamespaces", "xmlns:sr='http://www.loc.gov/zing/srw/' " & _
1254 | "xmlns:hold='http://www.loc.gov/standards/iso20775/'"
1255 | sBasePath = "sr:searchRetrieveResponse/sr:records/sr:record/sr:recordData/hold:holdings"
1256 | Else
1257 | oXMLDOM.SetProperty "SelectionNamespaces", "xmlns:sr='http://www.loc.gov/zing/srw/' " & _
1258 | "xmlns:marc='http://www.loc.gov/MARC21/slim'"
1259 | sBasePath = "sr:searchRetrieveResponse/sr:records/sr:record/sr:recordData/marc:record"
1260 |
1261 | End If
1262 | If LookupDialog.CatalogURLBox.Value = "source:recap" Then
1263 | oRegEx.Global = True
1264 | oRegEx.Pattern = "[\[,]{""id"":""([^""]*)"""
1265 |
1266 | sResultJSON = sResultXML
1267 | sResultString = ""
1268 | iCurrentPos = 1
1269 | Set oRecords = oRegEx.Execute(sResultJSON)
1270 | iRecords = oRecords.Count
1271 | If iRecords = 0 Then
1272 | ExtractField = "FALSE"
1273 | Exit Function
1274 | End If
1275 | For Each m In oRecords
1276 | sID = m.Submatches(0)
1277 | sResultJSON = Mid(sResultJSON, InStr(1, sResultJSON, m.Submatches(0)))
1278 | iRecLength = InStr(Len(m.Submatches(0)), sResultJSON, "},{""id""")
1279 | If iRecLength > 0 Then
1280 | sCurrentRecord = Left(sResultJSON, InStr(Len(m.Submatches(0)), sResultJSON, "},{""id"""))
1281 | Else
1282 | sCurrentRecord = sResultJSON
1283 | End If
1284 | For h = 0 To UBound(aResultFields)
1285 | If ExtractField <> "" And Right(ExtractField, 1) <> "|" Then
1286 | ExtractField = ExtractField & "|"
1287 | End If
1288 | sResultType = aResultFields(h)
1289 | Select Case sResultType
1290 | Case "exists"
1291 | ExtractField = "TRUE "
1292 | Case "001"
1293 | ExtractField = ExtractField & sID
1294 | Case "010"
1295 | oRegEx.Pattern = "\[([^\]]*)\],""label"":""Lccn S"""
1296 | Set oLCCNs = oRegEx.Execute(sCurrentRecord)
1297 | If oLCCNs.Count > 0 Then
1298 | sLCCNs = oLCCNs(0).Submatches(0)
1299 | sLCCNs = Replace(sLCCNs, """,""", ChrW(166))
1300 | sLCCNs = Replace(sLCCNs, """", "")
1301 | ExtractField = ExtractField & sLCCNs
1302 | Else
1303 | ExtractField = ExtractField & " "
1304 | End If
1305 | Case "020"
1306 | oRegEx.Pattern = "\[([^\]]*)\],""label"":""Isbn S"""
1307 | Set oISBNs = oRegEx.Execute(sCurrentRecord)
1308 | If oISBNs.Count > 0 Then
1309 | sISBNs = oISBNs(0).Submatches(0)
1310 | sISBNs = Replace(sISBNs, """,""", ChrW(166))
1311 | sISBNs = Replace(sISBNs, """", "")
1312 | ExtractField = ExtractField & sISBNs
1313 | Else
1314 | ExtractField = ExtractField & " "
1315 | End If
1316 | Case "035$a#(OCoLC)"
1317 | oRegEx.Pattern = "\[([^\]]*)\],""label"":""Oclc S"""
1318 | Set oOCLCs = oRegEx.Execute(sCurrentRecord)
1319 | If oOCLCs.Count > 0 Then
1320 | sOCLCs = oOCLCs(0).Submatches(0)
1321 | sOCLCs = Replace(sOCLCs, """,""", ChrW(166))
1322 | sOCLCs = Replace(sOCLCs, """", "")
1323 | ExtractField = ExtractField & sOCLCs
1324 | Else
1325 | ExtractField = ExtractField & " "
1326 | End If
1327 | Case "245"
1328 | oRegEx.Pattern = """attributes"":{""title"":""([^""]*)"""
1329 | Set oTitle = oRegEx.Execute(sCurrentRecord)
1330 | If oTitle.Count > 0 Then
1331 | ExtractField = ExtractField & oTitle(0).Submatches(0)
1332 | End If
1333 | Case "recap"
1334 | oRegEx.Pattern = """location_code"":""([^""]*)"""
1335 | Set oLoc = oRegEx.Execute(sCurrentRecord)
1336 | oRegEx.Pattern = """location"":""([^""]*)"""
1337 | Set oLocName = oRegEx.Execute(sCurrentRecord)
1338 | If oLoc.Count > 0 Then
1339 | sLoc = oLoc(0).Submatches(0)
1340 | Select Case sLoc
1341 | Case "scsbhl"
1342 | sLoc = "Harvard"
1343 | Case "scsbnypl"
1344 | sLoc = "NYPL"
1345 | Case "scsbcul"
1346 | sLoc = "Columbia"
1347 | Case Else
1348 | For i = 0 To oLocName.Count - 1
1349 | If InStr(1, oLocName(i).Submatches(0), "Remote Storage") > 0 Then
1350 | sLoc = "Princeton"
1351 | Exit For
1352 | End If
1353 | Next i
1354 | If sLoc <> "Princeton" Then
1355 | sLoc = ""
1356 | End If
1357 |
1358 | End Select
1359 | End If
1360 | If InStr(1, ExtractField, sLoc) = 0 Then
1361 | ExtractField = ExtractField & sLoc
1362 | Else
1363 | ExtractField = Left(ExtractField, Len(ExtractField) - 1)
1364 | End If
1365 | Case "recap_cgd"
1366 | oRegEx.Pattern = "(?:""location_code"":""([^""]*)""[^}]*)?(?:""description"":""([^""]*)""[^}]*)?(?:""use_statement"":""([^""]*)""[^}]*)?""cgd"":""([^""]*)""[^}]*""collection_code"":""([^""]*)"""
1367 | sCGD = ""
1368 | Set oCGD = oRegEx.Execute(sCurrentRecord)
1369 | sRecapLoc = ""
1370 | For i = 0 To oCGD.Count - 1
1371 | If oCGD(i).Submatches(0) <> "" Then
1372 | sRecapLoc = oCGD(i).Submatches(0)
1373 | sRecapLoc = Replace(sRecapLoc, "scsb", "")
1374 | End If
1375 | If sCGD <> "" Then
1376 | sCGD = sCGD & ChrW(166)
1377 | End If
1378 | sCGD = sCGD & sRecapLoc & "-" & oCGD(i).Submatches(4) & "-" & oCGD(i).Submatches(3)
1379 | If oCGD(i).Submatches(2) <> "" Then
1380 | sCGD = sCGD & "-" & oCGD(i).Submatches(2)
1381 | End If
1382 | If oCGD(i).Submatches(1) <> "" Then
1383 | sCGD = sCGD & "-" & oCGD(i).Submatches(1)
1384 | End If
1385 | Next i
1386 | ExtractField = ExtractField & sCGD
1387 | Case Else
1388 | ExtractField = "ERROR:InvalidRecap"
1389 | Exit Function
1390 | End Select
1391 | Next h
1392 | Next m
1393 | Exit Function
1394 | End If
1395 |
1396 | oXMLDOM.LoadXML (sResultXML)
1397 | Set aRecords = oXMLDOM.SelectNodes(sBasePath)
1398 |
1399 | iRecords = aRecords.length
1400 | If iRecords = 0 Then
1401 | ExtractField = "FALSE"
1402 | Exit Function
1403 | End If
1404 |
1405 | ExtractField = ""
1406 |
1407 | 'Iterate through results, compile result string
1408 | For i = 0 To iRecords - 1
1409 | If oXMLDOM.parseError.ErrorCode = 0 Then
1410 | sRecord = ""
1411 | For h = 0 To UBound(aResultFields)
1412 | If ExtractField <> "" And Right(ExtractField, 1) <> "|" Then
1413 | ExtractField = ExtractField & ChrW(166)
1414 | End If
1415 | sResultType = aResultFields(h)
1416 | sResultFilter = ""
1417 | iFilterPos = InStr(1, sResultType, "#")
1418 | If iFilterPos > 0 Then
1419 | sResultFilter = Mid(sResultType, iFilterPos + 1)
1420 | sResultType = Left(sResultType, iFilterPos - 1)
1421 | End If
1422 |
1423 | iSubStartPos = -1
1424 | iSubLength = -1
1425 | oRegEx.Pattern = "\(([0-9]+),([0-9]+)\)$"
1426 | Set oMatch = oRegEx.Execute(sResultType)
1427 | If oMatch.Count = 1 Then
1428 | iSubStartPos = oMatch(0).Submatches(0)
1429 | iSubLength = oMatch(0).Submatches(1)
1430 | If iSubLength = 0 Then
1431 | iSubLength = 9999
1432 | End If
1433 | sResultType = Left(sResultType, Len(sResultType) - Len(oMatch.Item(0)))
1434 | End If
1435 |
1436 | sBibPrefix = "marc:datafield"
1437 | If sResultType = "000" Then
1438 | sBibPrefix = "marc:leader"
1439 | ElseIf Left(sResultType, 2) Like "00" Then
1440 | sBibPrefix = "marc:controlfield"
1441 | End If
1442 | sHoldingsPrefix1 = "hold:holding/hold:holdingSimple/hold:copyInformation"
1443 | sHoldingsPrefix2 = "hold:holding/hold:holdingStructured/hold:set/hold:component"
1444 | Dim oFieldList As IXMLDOMNodeList
1445 | Select Case sResultType
1446 | Case "exists"
1447 | ExtractField = "TRUE "
1448 | Case "Barcode"
1449 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix1 & _
1450 | "/hold:pieceIdentifier/hold:value")
1451 | If oFieldList.length = 0 Then
1452 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix2 & _
1453 | "/hold:pieceIdentifier/hold:value")
1454 | End If
1455 | For j = 0 To oFieldList.length - 1
1456 | If sRecord <> "" Then
1457 | sRecord = sRecord & ChrW(166)
1458 | End If
1459 | sRecord = sRecord & oFieldList.Item(j).XML
1460 | oRegEx.Pattern = "<[^>]*>"
1461 | sRecord = oRegEx.Replace(sRecord, "")
1462 | Next j
1463 | ExtractField = ExtractField & sRecord
1464 | Case "Item Location"
1465 | Set oHoldings = aRecords(i).SelectNodes("hold:holding")
1466 | For j = 0 To oHoldings.length - 1
1467 | sRecord = ""
1468 | Set oLibraryCode = oHoldings(j).SelectNodes("hold:physicalLocation")
1469 | sLibraryCode = ""
1470 | If oLibraryCode.length = 1 Then
1471 | sLibraryCode = oLibraryCode.Item(0).Text
1472 | End If
1473 | If Not IsMissing(sBarcode) Then
1474 | Set oFieldList = oHoldings(j).SelectNodes(Replace(sHoldingsPrefix1, "hold:holding/", "") & _
1475 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:sublocation")
1476 | If oFieldList.length = 0 Then
1477 | Set oFieldList = oHoldings(j).SelectNodes(Replace(sHoldingsPrefix2, "hold:holding/", "") & _
1478 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:sublocation")
1479 | End If
1480 | Else
1481 | Set oFieldList = oHoldings(j).SelectNodes(Replace(sHoldingsPrefix1, "hold:holding/", "") & "/hold:sublocation")
1482 | If oFieldList.length = 0 Then
1483 | Set oFieldList = oHoldings(j).SelectNodes(Replace(sHoldingsPrefix2, "hold:holding/", "") & "/hold:sublocation")
1484 | End If
1485 | End If
1486 | For k = 0 To oFieldList.length - 1
1487 | If sRecord <> "" Then
1488 | sRecord = sRecord & ChrW(166)
1489 | End If
1490 | sRecord = sRecord & sLibraryCode & " " & oFieldList.Item(k).XML
1491 | oRegEx.Pattern = "<[^>]*>"
1492 | sRecord = oRegEx.Replace(sRecord, "")
1493 | Next k
1494 | If ExtractField <> "" And sRecord <> "" Then
1495 | ExtractField = ExtractField & "|"
1496 | End If
1497 | ExtractField = ExtractField & sRecord
1498 | Next j
1499 | Case "Item Enum/Chron"
1500 | If Not IsMissing(sBarcode) Then
1501 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix1 & _
1502 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:enumerationAndChronology/hold:text")
1503 | If oFieldList.length = 0 Then
1504 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix2 & _
1505 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:enumerationAndChronology/hold:text")
1506 | End If
1507 | Else
1508 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix1 & "/hold:enumerationAndChronology/hold:text")
1509 | If oFieldList.length = 0 Then
1510 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix2 & "/hold:enumerationAndChronology/hold:text")
1511 | End If
1512 | End If
1513 | For j = 0 To oFieldList.length - 1
1514 | If sRecord <> "" Then
1515 | sRecord = sRecord & ChrW(166)
1516 | End If
1517 | sRecord = sRecord & oFieldList.Item(j).XML
1518 | oRegEx.Pattern = "<[^>]*>"
1519 | sRecord = oRegEx.Replace(sRecord, "")
1520 | Next j
1521 | ExtractField = ExtractField & sRecord
1522 | Case "Shelf Locator"
1523 | If Not IsMissing(sBarcode) Then
1524 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix1 & _
1525 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:shelfLocator")
1526 | If oFieldList.length = 0 Then
1527 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix2 & _
1528 | "[hold:pieceIdentifier/hold:value='" & sBarcode & "']/hold:shelfLocator")
1529 | End If
1530 | Else
1531 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix1 & "/hold:shelfLocator")
1532 | If oFieldList.length = 0 Then
1533 | Set oFieldList = aRecords(i).SelectNodes(sHoldingsPrefix2 & "/hold:shelfLocator")
1534 | End If
1535 | End If
1536 | For j = 0 To oFieldList.length - 1
1537 | If sRecord <> "" Then
1538 | sRecord = sRecord & ChrW(166)
1539 | End If
1540 | sRecord = sRecord & oFieldList.Item(j).XML
1541 | oRegEx.Pattern = "<[^>]*>"
1542 | sRecord = oRegEx.Replace(sRecord, "")
1543 | Next j
1544 | ExtractField = ExtractField & sRecord
1545 | Case "000" To "999z", "AVA" To "AVAz", "AVD" To "AVDz", "AVE" To "AVEz"
1546 | If sResultType = "000" Then
1547 | Set oFieldList = aRecords(i).SelectNodes(sBibPrefix)
1548 | sRecord = oFieldList.Item(0).XML
1549 | oRegEx.Pattern = "<[^>]*>"
1550 | sRecord = oRegEx.Replace(sRecord, "")
1551 | ElseIf sResultType Like "###" Then
1552 | Set oFieldList = aRecords(i).SelectNodes(sBibPrefix & "[@tag='" & sResultType & "']")
1553 | For j = 0 To oFieldList.length - 1
1554 | If sRecord <> "" Then
1555 | sRecord = sRecord & ChrW(166)
1556 | End If
1557 | sRecord = sRecord & oFieldList.Item(j).XML
1558 | Next j
1559 |
1560 | If LookupDialog.IncludeExtrasCheckBox.Value = True Then
1561 | oRegEx.Pattern = ""
1562 | sRecord = oRegEx.Replace(sRecord, "$$$1 ")
1563 | sRecord = Replace(sRecord, "ind1="" """, "ind1=""_""")
1564 | sRecord = Replace(sRecord, "ind2="" """, "ind2=""_""")
1565 | oRegEx.Pattern = "]*\s*ind1=.(.).\s*ind2=.(.).[^>]*>"
1566 | sRecord = oRegEx.Replace(sRecord, "$1$2")
1567 | Else
1568 | oRegEx.Pattern = "[^<]*"
1569 | sRecord = oRegEx.Replace(sRecord, "")
1570 | End If
1571 | oRegEx.Pattern = "<[^>]*>"
1572 | sRecord = oRegEx.Replace(sRecord, " ")
1573 | oRegEx.Pattern = "^\s+"
1574 | sRecord = oRegEx.Replace(sRecord, "")
1575 | If Not Left(sResultType, 2) Like "00" Then
1576 | oRegEx.Pattern = "\s+$"
1577 | sRecord = oRegEx.Replace(sRecord, "")
1578 | oRegEx.Pattern = "\s\s+"
1579 | sRecord = oRegEx.Replace(sRecord, " ")
1580 | End If
1581 | ElseIf sResultType Like "###-880" Then
1582 | sMainField = Left(sResultType, 3)
1583 | Set oFieldList = aRecords(i).SelectNodes(sBibPrefix & "[@tag='880'][marc:subfield[@code='6' and starts-with(text(),'" & sMainField & "')]]")
1584 | For j = 0 To oFieldList.length - 1
1585 | If sRecord <> "" Then
1586 | sRecord = sRecord & ChrW(166)
1587 | End If
1588 | sRecord = sRecord & oFieldList.Item(j).XML
1589 | Next j
1590 |
1591 | If LookupDialog.IncludeExtrasCheckBox.Value = True Then
1592 | oRegEx.Pattern = ""
1593 | sRecord = oRegEx.Replace(sRecord, "$$$1 ")
1594 | sRecord = Replace(sRecord, "ind1="" """, "ind1=""_""")
1595 | sRecord = Replace(sRecord, "ind2="" """, "ind2=""_""")
1596 | oRegEx.Pattern = "]*\s*ind1=.(.).\s*ind2=.(.).[^>]*>"
1597 | sRecord = oRegEx.Replace(sRecord, "$1$2")
1598 | Else
1599 | oRegEx.Pattern = "[^<]*"
1600 | sRecord = oRegEx.Replace(sRecord, "")
1601 | End If
1602 |
1603 | oRegEx.Pattern = "<[^>]*>"
1604 | sRecord = oRegEx.Replace(sRecord, " ")
1605 | oRegEx.Pattern = "^\s+"
1606 | sRecord = oRegEx.Replace(sRecord, "")
1607 | If Not Left(sResultType, 2) Like "00" Then
1608 | oRegEx.Pattern = "\s+$"
1609 | sRecord = oRegEx.Replace(sRecord, "")
1610 | oRegEx.Pattern = "\s\s+"
1611 | sRecord = oRegEx.Replace(sRecord, " ")
1612 | End If
1613 | ElseIf sResultType Like "###$?*" Or sResultType Like "AVA$?*" _
1614 | Or sResultType Like "AVD$?*" Or sResultType Like "AVE$?*" Then
1615 |
1616 | sMainField = Left(sResultType, 3)
1617 | sSubfield = Mid(sResultType, 5, 99)
1618 | sSubfieldQuery = "[@code='"
1619 | For j = 1 To Len(sSubfield)
1620 | If j > 1 Then
1621 | sSubfieldQuery = sSubfieldQuery & "' or @code='"
1622 | End If
1623 | sSubfieldQuery = sSubfieldQuery & Mid(sSubfield, j, 1)
1624 | Next j
1625 | sSubfieldQuery = sSubfieldQuery & "']"
1626 |
1627 | Set oFieldList = aRecords(i).SelectNodes(sBibPrefix & "[@tag='" & sMainField & "']")
1628 | For j = 0 To oFieldList.length - 1
1629 | If sRecord <> "" And Right(sRecord, 1) <> ChrW(166) Then
1630 | sRecord = sRecord & ChrW(166)
1631 | End If
1632 | Set oSubfieldList = oFieldList.Item(j).SelectNodes("marc:subfield" & sSubfieldQuery)
1633 | For k = 0 To oSubfieldList.length - 1
1634 | sRecord = sRecord & oSubfieldList.Item(k).XML
1635 | Next k
1636 | Next j
1637 | oRegEx.Pattern = "<[^>]*>"
1638 | sRecord = oRegEx.Replace(sRecord, " ")
1639 | oRegEx.Pattern = " *"
1640 | sRecord = oRegEx.Replace(sRecord, " ")
1641 | ElseIf sResultType Like "###-880$?*" Then
1642 | sField = Left(sResultType, 3)
1643 | sSubfield = Mid(sResultType, 9, 99)
1644 | sSubfieldQuery = "[@code='"
1645 | For j = 1 To Len(sSubfield)
1646 | If j > 1 Then
1647 | sSubfieldQuery = sSubfieldQuery & "' or @code='"
1648 | End If
1649 | sSubfieldQuery = sSubfieldQuery & Mid(sSubfield, j, 1)
1650 | Next j
1651 | sSubfieldQuery = sSubfieldQuery & "']"
1652 |
1653 | Set oFieldList = aRecords(i).SelectNodes(sBibPrefix & "[@tag='880'][marc:subfield[@code='6' and starts-with(text(),'" & sField & "')]]")
1654 | For j = 0 To oFieldList.length - 1
1655 | If sRecord <> "" And Right(sRecord, 1) <> ChrW(166) Then
1656 | sRecord = sRecord & ChrW(166)
1657 | End If
1658 | Set oSubfieldList = oFieldList.Item(j).SelectNodes("marc:subfield" & sSubfieldQuery)
1659 | For k = 0 To oSubfieldList.length - 1
1660 | sRecord = sRecord & oSubfieldList.Item(k).XML
1661 | Next k
1662 | Next j
1663 |
1664 | oRegEx.Pattern = "<[^>]*>"
1665 | sRecord = oRegEx.Replace(sRecord, " ")
1666 | oRegEx.Pattern = " *"
1667 | sRecord = oRegEx.Replace(sRecord, " ")
1668 | Else
1669 | sRecord = "Error in field/subfield name"
1670 | End If
1671 | oRegEx.Pattern = " \u00A6 "
1672 | sRecord = Trim(oRegEx.Replace(sRecord, ChrW(166)))
1673 |
1674 | If iSubStartPos > -1 And iSubLength > 0 Then
1675 | sRecordFiltered = ""
1676 | aResults = Split(sRecord, ChrW(166), -1, 0)
1677 | For j = 0 To UBound(aResults)
1678 | If sRecordFiltered <> "" Then
1679 | sRecordFiltered = sRecordFiltered & ChrW(166)
1680 | End If
1681 | sRecordFiltered = sRecordFiltered & Mid(aResults(j), iSubStartPos + 1, iSubLength)
1682 | Next j
1683 | sRecord = sRecordFiltered
1684 | End If
1685 |
1686 | If sResultFilter <> "" Then
1687 | sRecordFiltered = ""
1688 | aResults = Split(sRecord, ChrW(166), -1, 0)
1689 | For j = 0 To UBound(aResults)
1690 | If InStr(1, aResults(j), sResultFilter) > 0 Then
1691 | If sRecordFiltered <> "" Then
1692 | sRecordFiltered = sRecordFiltered & ChrW(166)
1693 | End If
1694 | sRecordFiltered = sRecordFiltered & aResults(j)
1695 | End If
1696 | Next j
1697 | sRecord = sRecordFiltered
1698 | End If
1699 | ExtractField = ExtractField & sRecord
1700 | Case Else
1701 | ExtractField = ExtractField & "ERROR"
1702 | End Select
1703 | sRecord = ""
1704 | Next h
1705 | ExtractField = ExtractField & "|"
1706 | Else
1707 | ExtractField = ExtractField & "ERROR" & "|"
1708 | End If
1709 | Next i
1710 | If Len(ExtractField) > 0 Then
1711 | ExtractField = Left(ExtractField, Len(ExtractField) - 1)
1712 | If Right(ExtractField, 1) = ChrW(166) Then
1713 | ExtractField = Left(ExtractField, Len(ExtractField) - 1)
1714 | End If
1715 | ExtractField = Replace(ExtractField, Chr(10), "")
1716 | ExtractField = Replace(ExtractField, Chr(13), "")
1717 | Else
1718 | If sResultType = "exists" Then
1719 | ExtractField = "FALSE"
1720 | Else
1721 | ExtractField = "TRUE"
1722 | End If
1723 | End If
1724 | oRegEx.Pattern = "&[^; ]+;"
1725 | If oRegEx.Test(ExtractField) Then
1726 | ExtractField = HtmlDecode(ExtractField)
1727 | If oRegEx.Test(ExtractField) Then
1728 | ExtractField = HtmlDecode(ExtractField)
1729 | End If
1730 | End If
1731 | If LookupDialog.CatalogURLBox.Value = "source:borrowdirect" Then
1732 | ExtractField = DecodeIPLCUnicode(ExtractField)
1733 | End If
1734 | If sResultType = "999$sp" Then
1735 | ExtractField = CollapseIPLCHoldings(ExtractField)
1736 | End If
1737 | If LookupDialog.CatalogURLBox.Value = "source:worldcat" And sResultTypeAll = "948$c#" Then
1738 | sCodesDeDupe = ""
1739 | iCodeCount = 0
1740 | aCodesA = Split(ExtractField, "|")
1741 | For i = 0 To UBound(aCodesA)
1742 | aCodesB = Split(aCodesA(i), ChrW(166))
1743 | For j = 0 To UBound(aCodesB)
1744 | If InStr(1, sCodesDeDupe, aCodesB(j)) = 0 Then
1745 | sCodesDeDupe = sCodesDeDupe & aCodesB(j) & "|"
1746 | iCodeCount = iCodeCount + 1
1747 | End If
1748 | Next j
1749 | Next i
1750 | ExtractField = CStr(iCodeCount)
1751 | End If
1752 | End Function
1753 |
1754 | Function CollapseIPLCHoldings(sHoldings)
1755 | sResult = ""
1756 | aHoldingsA = Split(sHoldings, "|")
1757 | For i = 0 To UBound(aHoldingsA)
1758 | aHoldingsB = Split(aHoldingsA(i), ChrW(166))
1759 | For j = 0 To UBound(aHoldingsB)
1760 | sHCode = aHoldingsB(j)
1761 | sHCode = Replace(sHCode, "ISIL:", "")
1762 | iSpace = InStr(1, sHCode, " ")
1763 | If iSpace > 0 Then
1764 | sHCodeA = Left(sHCode, iSpace - 1)
1765 | sHCodeB = Mid(sHCode, iSpace + 1)
1766 | If InStr(1, sResult, sHCodeA) = 0 Then
1767 | If sResult <> "" Then
1768 | sResult = sResult & "|"
1769 | End If
1770 | sResult = sResult & sHCode
1771 | ElseIf InStr(1, sResult, sHCode) = 0 Then
1772 | sResult = Replace(sResult, sHCodeA, sHCode)
1773 | End If
1774 | Else
1775 | If InStr(1, sResult, sHCode) = 0 Then
1776 | If sResult <> "" Then
1777 | sResult = sResult & "|"
1778 | End If
1779 | sResult = sResult & sHCode
1780 | End If
1781 | End If
1782 | Next j
1783 | Next i
1784 | CollapseIPLCHoldings = sResult
1785 | End Function
1786 |
1787 | Function DecodeIPLCUnicode(sSource As String) As String
1788 | oRegEx.Pattern = "\\u[0-9a-f]{4}"
1789 | oRegEx.Global = True
1790 | Set oMatch = oRegEx.Execute(sSource)
1791 | For i = 0 To oMatch.Count - 1
1792 | sDecoded = Mid(CStr(oMatch.Item(i)), 3)
1793 | sDecoded = ChrW(CDec("&H" & sDecoded))
1794 | sSource = Replace(sSource, oMatch.Item(i), sDecoded)
1795 | Next i
1796 | DecodeIPLCUnicode = sSource
1797 | End Function
1798 |
1799 | Function NormalizeISBN(sQuery As String) As String
1800 | With oRegEx
1801 | .MultiLine = False
1802 | .Global = True
1803 | .IgnoreCase = True
1804 | End With
1805 | sQuery = Replace(sQuery, "-", "")
1806 | oRegEx.Pattern = "[0-9]{13}"
1807 | Set oMatch = oRegEx.Execute(sQuery)
1808 | If oMatch.Count = 0 Then
1809 | oRegEx.Pattern = "[0-9]{9}([0-9]|X)"
1810 | Set oMatch = oRegEx.Execute(sQuery)
1811 | If oMatch.Count = 0 Then
1812 | NormalizeISBN = ""
1813 | Else
1814 | NormalizeISBN = oMatch.Item(0)
1815 | End If
1816 | Else
1817 | NormalizeISBN = oMatch.Item(0)
1818 | End If
1819 | If LookupDialog.ValidateCheckBox.Value Then
1820 | NormalizeISBN = GenerateCheckDigit(NormalizeISBN)
1821 | NormalizeISBN = GetOtherISBN(NormalizeISBN)
1822 | End If
1823 | End Function
1824 |
1825 | Function GetOtherISBN(sISBN As String) As String
1826 | sOtherISBN = ""
1827 | If Len(sISBN) = 10 Then
1828 | sOtherISBN = "978" & Left(sISBN, 9)
1829 | iChecksum = 0
1830 | For i = 1 To 12
1831 | iMul = 1
1832 | If i Mod 2 = 0 Then
1833 | iMul = 3
1834 | End If
1835 | iChecksum = iChecksum + (iMul * CInt(Mid(sOtherISBN, i, 1)))
1836 | Next i
1837 | iChecksum = iChecksum Mod 10
1838 | If iChecksum > 0 Then
1839 | iChecksum = 10 - iChecksum
1840 | End If
1841 | sOtherISBN = sOtherISBN & iChecksum
1842 | ElseIf Len(sISBN) = 13 Then
1843 | sOtherISBN = Mid(sISBN, 4, 9)
1844 | For i = 1 To 9
1845 | iMul = 11 - i
1846 | iChecksum = iChecksum + (iMul * CInt(Mid(sOtherISBN, i, 1)))
1847 | Next i
1848 | iChecksum = iChecksum Mod 11
1849 | If iChecksum > 0 Then
1850 | iChecksum = 11 - iChecksum
1851 | End If
1852 | If iChecksum = 10 Then
1853 | sOtherISBN = sOtherISBN & "X"
1854 | Else
1855 | sOtherISBN = sOtherISBN & iChecksum
1856 | End If
1857 | End If
1858 | If sOtherISBN <> "" Then
1859 | GetOtherISBN = sISBN & "|" & sOtherISBN
1860 | Else
1861 | GetOtherISBN = sISBN
1862 | End If
1863 | End Function
1864 |
1865 | Function GenerateCheckDigit(sISXN As String) As String
1866 | iChecksum = 0
1867 | If Len(sISXN) <> 8 And Len(sISXN) <> 10 And Len(sISXN) <> 13 Then
1868 | GenerateCheckDigit = "INVALID"
1869 | Exit Function
1870 | End If
1871 | GenerateCheckDigit = Left(sISXN, Len(sISXN) - 1)
1872 | If Len(sISXN) = 8 Then
1873 | For i = 1 To 7
1874 | iMul = 9 - i
1875 | iChecksum = iChecksum + (iMul * CInt(Mid(sISXN, i, 1)))
1876 | Next i
1877 | iChecksum = iChecksum Mod 11
1878 | If iChecksum > 0 Then
1879 | iChecksum = 11 - iChecksum
1880 | End If
1881 | If iChecksum = 10 Then
1882 | GenerateCheckDigit = GenerateCheckDigit & "X"
1883 | Else
1884 | GenerateCheckDigit = GenerateCheckDigit & iChecksum
1885 | End If
1886 | ElseIf Len(sISXN) = 10 Then
1887 | For i = 1 To 9
1888 | iMul = 11 - i
1889 | iChecksum = iChecksum + (iMul * CInt(Mid(sISXN, i, 1)))
1890 | Next i
1891 | iChecksum = iChecksum Mod 11
1892 | If iChecksum > 0 Then
1893 | iChecksum = 11 - iChecksum
1894 | End If
1895 | If iChecksum = 10 Then
1896 | GenerateCheckDigit = GenerateCheckDigit & "X"
1897 | Else
1898 | GenerateCheckDigit = GenerateCheckDigit & iChecksum
1899 | End If
1900 | ElseIf Len(sISXN) = 13 Then
1901 | For i = 1 To 12
1902 | iMul = 1
1903 | If i Mod 2 = 0 Then
1904 | iMul = 3
1905 | End If
1906 | iChecksum = iChecksum + (iMul * CInt(Mid(GenerateCheckDigit, i, 1)))
1907 | Next i
1908 | iChecksum = iChecksum Mod 10
1909 | If iChecksum > 0 Then
1910 | iChecksum = 10 - iChecksum
1911 | End If
1912 | GenerateCheckDigit = GenerateCheckDigit & iChecksum
1913 | Else
1914 | GenerateCheckDigit = "INVALID"
1915 | End If
1916 | If GenerateCheckDigit <> sISXN Then
1917 | GenerateCheckDigit = "INVALID"
1918 | End If
1919 | End Function
1920 |
1921 | Function NormalizeOCLC(sQuery As String) As String
1922 | With oRegEx
1923 | .MultiLine = False
1924 | .Global = True
1925 | .IgnoreCase = True
1926 | End With
1927 | oRegEx.Pattern = "^[^0-9]*"
1928 | sQuery = oRegEx.Replace(sQuery, "")
1929 | oRegEx.Pattern = "[^0-9].*$"
1930 | sQuery = oRegEx.Replace(sQuery, "")
1931 | oRegEx.Pattern = "^0*"
1932 | sQuery = oRegEx.Replace(sQuery, "")
1933 | If sQuery = "" Then
1934 | sQuery = "FALSE"
1935 | End If
1936 | NormalizeOCLC = sQuery
1937 | End Function
1938 |
1939 | Function NormalizeISSN(sQuery As String) As String
1940 | With oRegEx
1941 | .MultiLine = False
1942 | .Global = True
1943 | .IgnoreCase = True
1944 | End With
1945 | sQuery = Replace(sQuery, "-", "")
1946 | oRegEx.Pattern = "[0-9]{7}([0-9]|X)"
1947 | Set oMatch = oRegEx.Execute(sQuery)
1948 | If oMatch.Count = 0 Then
1949 | NormalizeISSN = ""
1950 | Else
1951 | NormalizeISSN = Left(sQuery, 8)
1952 | End If
1953 | If LookupDialog.ValidateCheckBox.Value Then
1954 | NormalizeISSN = GenerateCheckDigit(NormalizeISSN)
1955 | End If
1956 | End Function
1957 |
1958 | Public Function HtmlDecode(StringToDecode As Variant) As String
1959 | oRegEx.Global = True
1960 | oRegEx.Pattern = "&[^; ]+;"
1961 | Set oMatch = oRegEx.Execute(StringToDecode)
1962 | For i = 0 To oMatch.Count - 1
1963 | sEntity = CStr(oMatch.Item(i))
1964 | StringToDecode = Replace(StringToDecode, sEntity, LCase(sEntity))
1965 | Next i
1966 | Set oMSHTML = CreateObject("htmlfile")
1967 | Set E = oMSHTML.createElement("T")
1968 | E.innerHTML = StringToDecode
1969 | HtmlDecode = E.innerText
1970 | End Function
--------------------------------------------------------------------------------
/src.vba/LookupDialog.frm:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "LookupDialog"
2 | Attribute VB_Base = "0{16FF341D-0EE7-4F89-93FE-34E2A1FF4C5F}{256B067F-FB9F-4AC1-99BF-E53B71023325}"
3 | Attribute VB_GlobalNameSpace = False
4 | Attribute VB_Creatable = False
5 | Attribute VB_PredeclaredId = True
6 | Attribute VB_Exposed = False
7 | Attribute VB_TemplateDerived = False
8 | Attribute VB_Customizable = False
9 | Private Sub AdditionalFieldsButton_Click()
10 | Catalog.aExplainFields = Catalog.GetAllFields()
11 | AdditionalFieldsDialog.FilterBox.Value = ""
12 | If Not IsNull(aExplainFields) Then
13 | AdditionalFieldsDialog.SRUFields.List = aExplainFields
14 | AdditionalFieldsDialog.Show
15 | End If
16 | End Sub
17 |
18 | Private Sub AddResultButton_Click()
19 | With LookupDialog
20 | If ResultTypeCombo.Value <> "" Then
21 | If ResultTypeList.ListIndex > -1 Then
22 | ResultTypeList.AddItem ResultTypeCombo.Value, ResultTypeList.ListIndex
23 | Else
24 | ResultTypeList.AddItem ResultTypeCombo.Value
25 | End If
26 | End If
27 | End With
28 | End Sub
29 |
30 | Private Sub AddSearchButton_Click()
31 | If SearchFieldCombo.Value = "" Or OperatorCombo.Value = "" Or SearchValueBox.Value = "" Then
32 | MsgBox ("Please make sure the search type, operator, and value are all filled in.")
33 | End If
34 | SearchListBox.AddItem ""
35 | iIndex = SearchListBox.ListCount - 1
36 | SearchListBox.List(iIndex, 0) = BooleanCombo.Value
37 | SearchListBox.List(iIndex, 1) = SearchFieldCombo.Value
38 | SearchListBox.List(iIndex, 2) = OperatorCombo.Value
39 | SearchListBox.List(iIndex, 3) = SearchValueBox.Value
40 | LookupDialog.BooleanCombo.Enabled = True
41 | LookupDialog.BooleanCombo.ListIndex = 0
42 | End Sub
43 |
44 | Private Sub AddURLButton_Click()
45 | If Catalog.bIsAlma Then
46 | aFieldMap = Catalog.GetAllFields()
47 | If Not IsNull(aFieldMap) Then
48 | Catalog.AddURLtoRegistry CatalogURLBox.Value
49 | End If
50 | Else
51 | Catalog.AddURLtoRegistry CatalogURLBox.Value
52 | End If
53 | End Sub
54 |
55 | Private Sub CancelButton_Click()
56 | LookupDialog.Hide
57 | End
58 | End Sub
59 |
60 | Private Sub CatalogURLBox_Change()
61 | If CatalogURLBox.Value <> "" Then
62 | Catalog.sAuth = ""
63 | iSelected = Catalog.GetSourceRegIndex(CatalogURLBox.Value)
64 | sAuth = GetSetting(Catalog.sRegistryDir, "Sources", "AUTH" & Format(iSelected, "000"), "")
65 | SaveSetting Catalog.sRegistryDir, "Sources", "SELECTED", CatalogURLBox.Value
66 | Catalog.bIsAlma = True
67 | If InStr(1, LookupDialog.CatalogURLBox, "source:") = 1 Then
68 | Catalog.bIsAlma = False
69 | End If
70 | Catalog.PopulateSourceDependentOptions
71 | End If
72 | End Sub
73 |
74 | Private Sub ClearCredentialsButton_Click()
75 | Catalog.ClearRegistryAuth (CatalogURLBox.Value)
76 | Catalog.sAuth = ""
77 | End Sub
78 |
79 | Private Sub DeleteSetButton_Click()
80 | iSetIndex = LookupDialog.FieldSetList.ListIndex
81 | If iSetIndex < 0 Then
82 | MsgBox ("Please select a set name")
83 | Exit Sub
84 | End If
85 |
86 | sSelectedSet = LookupDialog.FieldSetList.List(iSetIndex)
87 | Debug.Print "*" & sSelectedSet & "*"
88 | Catalog.DeleteFieldSet sSelectedSet
89 | LookupDialog.FieldSetList.RemoveItem iSetIndex
90 | LookupDialog.FieldSetList.ListIndex = -1
91 | Catalog.RedrawButtons
92 | End Sub
93 |
94 | Private Sub FieldSetList_Change()
95 | RedrawButtons
96 | End Sub
97 |
98 | Private Sub FieldSetList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
99 | If LookupDialog.FieldSetList.ListIndex > -1 Then
100 | sSelectedSet = LookupDialog.FieldSetList.Value
101 | bSuccess = LoadSet(CStr(sSelectedSet))
102 | End If
103 | End Sub
104 |
105 | Private Function LoadSet(sSetName As String) As Boolean
106 | LookupDialog.ResultTypeList.Clear
107 |
108 | iMax = GetSetting(Catalog.sRegistryDir, "FieldSets", "MAXALL", -1)
109 | For i = 0 To iMax
110 | sRegName = GetSetting(Catalog.sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "")
111 | If sRegName = sSetName Then
112 | iSetMax = GetSetting(Catalog.sRegistryDir, "FieldSets", "MAX" & Format(i, "000"), -1)
113 | For j = 0 To iSetMax
114 | sField = GetSetting(Catalog.sRegistryDir, "FieldSets", "FIELD" & Format(i, "000") & "-" & Format(j, "000"))
115 | LookupDialog.ResultTypeList.AddItem sField
116 | Next j
117 | LoadSet = True
118 | Exit Function
119 | End If
120 | Next i
121 | LoadSet = False
122 | End Function
123 |
124 |
125 | Private Sub HelpButton_Click()
126 | ThisWorkbook.FollowHyperlink Catalog.sRepoURL & "#readme"
127 | End Sub
128 |
129 | Private Sub IgnoreHeaderCheckbox_Click()
130 | If LookupDialog.IgnoreHeaderCheckbox.Value = True Then
131 | LookupDialog.GenerateHeaderCheckBox.Enabled = True
132 | Else
133 | LookupDialog.GenerateHeaderCheckBox.Enabled = False
134 | End If
135 | End Sub
136 |
137 | Private Sub LoadSetButton_Click()
138 | If LookupDialog.FieldSetList.ListIndex < 0 Then
139 | MsgBox ("Please select a set name")
140 | Exit Sub
141 | End If
142 | sSelectedSet = LookupDialog.FieldSetList.Value
143 | bSuccess = LoadSet(CStr(sSelectedSet))
144 |
145 | End Sub
146 |
147 | Private Sub MoveDownButton_Click()
148 | With LookupDialog.ResultTypeList
149 | Index = .ListIndex
150 | If Index < .ListCount - 1 Then
151 | t = .List(Index)
152 | .List(Index) = .List(Index + 1)
153 | .List(Index + 1) = t
154 | .Selected(Index + 1) = True
155 | End If
156 | End With
157 | End Sub
158 |
159 | Private Sub MoveUpButton_Click()
160 | With LookupDialog.ResultTypeList
161 | Index = .ListIndex
162 | If Index > 0 Then
163 | t = .List(Index)
164 | .List(Index) = .List(Index - 1)
165 | .List(Index - 1) = t
166 | .Selected(Index - 1) = True
167 | End If
168 | End With
169 | End Sub
170 |
171 | Private Sub NewSetButton_Click()
172 | bError = False
173 | sNewName = InputBox("Enter the Name of the New Set", "New Set")
174 | If sNewName = "" Then
175 | bError = True
176 | End If
177 | If Not bError And InStr(1, sNewName, "|") > 0 Or InStr(1, sNewName, ChrW(166)) Then
178 | MsgBox ("Set name cannot contain vertical bar characters")
179 | bError = True
180 | End If
181 | If Not bError Then
182 | iMax = GetSetting(Catalog.sRegistryDir, "FieldSets", "MAXALL", -1)
183 | For i = 0 To iMax
184 | sRegName = GetSetting(Catalog.sRegistryDir, "FieldSets", "NAME" & Format(i, "000"), "")
185 | If sRegName = sNewName Then
186 | MsgBox ("Set name already exists")
187 | bError = True
188 | End If
189 | Next i
190 | End If
191 | If Not bError Then
192 | bSuccess = Catalog.SaveFieldSet(sNewName)
193 | If bSuccess Then
194 | LookupDialog.FieldSetList.AddItem sNewName
195 | LookupDialog.FieldSetList.ListIndex = LookupDialog.FieldSetList.ListCount - 1
196 | End If
197 | End If
198 | End Sub
199 |
200 | Private Sub OKButton_Click()
201 | If Catalog.bIsAlma Then
202 | aFieldMap = Catalog.GetAllFields()
203 | If IsNull(aFieldMap) Then
204 | Exit Sub
205 | End If
206 | End If
207 | Dim sCatalogURL As String
208 | sCatalogURL = CStr(LookupDialog.CatalogURLBox.Text)
209 | If sCatalogURL = "source:worldcat" Then
210 | bSuccess = Catalog.Z3950Connect(sCatalogURL)
211 | If Not bSuccess Then
212 | Exit Sub
213 | End If
214 | End If
215 | Catalog.AddURLtoRegistry (sCatalogURL)
216 | iResultColumn = LookupDialog.ResultColumnSpinner.Value
217 | If LookupDialog.ResultTypeList.ListCount = 0 Then
218 | AddResultButton_Click
219 | End If
220 |
221 | 'Disable ISO Holdings if result types do not require them
222 | If Catalog.bIsoholdEnabled = True Then
223 | Catalog.bIsoholdEnabled = False
224 | For i = 0 To LookupDialog.ResultTypeList.ListCount - 1
225 | Dim sResType As String
226 | sResType = LookupDialog.ResultTypeList.List(i)
227 | If Left(sResType, 2) = "**" Then
228 | Catalog.bIsoholdEnabled = True
229 | Exit For
230 | End If
231 | Next i
232 | End If
233 | 'Validate selected range, truncate to part containing actual data
234 |
235 | Set oSourceRange = Workbooks(Catalog.sFileName).Worksheets(Catalog.sSheetName).Range(LookupRange.Value)
236 | If IsObject(oSourceRange) Then
237 | LookupDialog.Hide
238 | With oSourceRange
239 | iRowCount = .Rows.Count
240 | iSourceColumn = .Cells(1, 1).Column
241 | iFirstSourceRow = .Cells(1, 1).Row
242 | If LookupRange.Value Like "*#*" Then
243 | iLastSourceRow = iFirstSourceRow + iRowCount - 1
244 | Else
245 | iLastSourceRow = .Range("A999999").End(xlUp).Row
246 | End If
247 | If iFirstSourceRow + .Rows.Count - 1 < iLastSourceRow Then
248 | iLastSourceRow = iFirstSourceRow + .Rows.Count - 1
249 | End If
250 | End With
251 | iStartIndex = 1
252 | Catalog.bTerminateLoop = False
253 | iTotal = iLastSourceRow - iFirstSourceRow + 1
254 | SearchingDialog.ProgressLabel = "Row 1 of " & iTotal
255 | SearchingDialog.Show
256 | 'Iterate through rows, look up in catalog
257 | bIgnoreHeader = LookupDialog.IgnoreHeaderCheckbox.Value
258 | For i = iStartIndex To iTotal
259 | If Catalog.bTerminateLoop = True Then
260 | Exit For
261 | End If
262 | If Not oSourceRange.Rows(i).EntireRow.Hidden Then
263 | SearchingDialog.ProgressLabel = "Row " & i & " of " & iTotal
264 | Application.ScreenUpdating = False
265 | Dim sSearchString As String
266 | Set oSearchRow = oSourceRange.Rows(i).EntireRow
267 | If i = iStartIndex And bIgnoreHeader Then
268 | sResultRec = "HEADER"
269 | Else
270 | sResultRec = Catalog.Lookup(oSearchRow, sCatalogURL)
271 | End If
272 | If sResultRec <> "" Then
273 | iHoldingsStart = InStr(2, sResultRec, " 0 Then
275 | sResultHold = Mid(sResultRec, iHoldingsStart)
276 | sResultRec = Left(sResultRec, iHoldingsStart - 1)
277 | End If
278 | For j = 0 To LookupDialog.ResultTypeList.ListCount - 1
279 | Dim stype As String
280 | stype = LookupDialog.ResultTypeList.List(j)
281 | stype = Replace(stype, "*", "")
282 | If i = iStartIndex And bIgnoreHeader Then
283 | sResult = ""
284 | If LookupDialog.GenerateHeaderCheckBox.Value = True Then
285 | sResult = stype
286 | End If
287 | GoTo NextRow
288 | End If
289 | If stype = "MMS ID" Or stype = "Catalog ID" Or _
290 | (LookupDialog.CatalogURLBox.Value = "source:worldcat" And stype = "OCLC No.") Then
291 | stype = "001"
292 | ElseIf stype = "LCCN" Then
293 | stype = "010"
294 | ElseIf stype = "ISBN" Then
295 | stype = "020"
296 | ElseIf stype = "ISSN" Then
297 | stype = "022"
298 | ElseIf stype = "Title" Then
299 | stype = "245"
300 | ElseIf stype = "OCLC No." Then
301 | stype = "035$a#(OCoLC)"
302 | ElseIf stype = "Call No." Then
303 | stype = "AVA$d"
304 | ElseIf stype = "Location/DB Name" Then
305 | stype = "AVA$bj|AVE$lm"
306 | ElseIf stype = "Language code" Then
307 | stype = "008(35,3)"
308 | ElseIf stype = "Coverage" Then
309 | stype = "AVA$t|AVE$s"
310 | ElseIf InStr(1, stype, "Leader") = 1 Or InStr(1, stype, "LDR") Then
311 | stype = Replace(stype, "Leader", "000")
312 | stype = Replace(stype, "LDR", "000")
313 | ElseIf stype = "True/False" Then
314 | stype = "exists"
315 | ElseIf stype = "ReCAP Holdings" Then
316 | stype = "recap"
317 | ElseIf stype = "ReCAP CGD" Then
318 | stype = "recap_cgd"
319 | ElseIf stype = "BorrowDirect Holdings" Then
320 | stype = "999$sp"
321 | ElseIf stype = "WorldCat Holdings" Then
322 | stype = "948$c"
323 | ElseIf LookupDialog.CatalogURLBox.Value = "source:worldcat" And stype = "Holdings Count" Then
324 | stype = "948$c#"
325 | End If
326 | If sResultRec = "" Then
327 | sResult = ""
328 | ElseIf sResultRec = "INVALID" Then
329 | sResult = "INVALID"
330 | Else
331 | If stype = "Barcode" Then
332 | sResult = ExtractField(stype, CStr(sResultHold), True)
333 | ElseIf stype = "Item Location" Or stype = "Item Enum/Chron" Or stype = "Shelf Locator" Then
334 | sSearchType = CStr(LookupDialog.SearchFieldCombo.Value)
335 | sBarcode = ""
336 | If sSearchType = "Barcode" Or sSearchType = "alma.barcode" Then
337 | sResult = ExtractField(stype, CStr(sResultHold), True, sSearchString)
338 | Else
339 | sResult = ExtractField(stype, CStr(sResultHold), True)
340 | End If
341 | Else
342 | sResult = ExtractField(stype, CStr(sResultRec), False)
343 | If sResult = "ERROR:InvalidRecap" Then
344 | MsgBox ("ReCAP queries do not support the result type: """ & LookupDialog.ResultTypeList.List(j) & """")
345 | SearchingDialog.Hide
346 | LookupDialog.Show
347 | Exit Sub
348 | End If
349 | End If
350 | iExtraBars = (Len(sResult) - Len(Replace(sResult, "|", ""))) - _
351 | (Len(sSearchString) - Len(Replace(sSearchString, "|", "")))
352 | If Right(sResult, 1) = "|" And iExtraBars <> 0 Then
353 | sResult = Left(sResult, Len(sResult) - 1)
354 | End If
355 | End If
356 | If sResult = "" Then
357 | sResult = False
358 | End If
359 | NextRow:
360 | oSourceRange.Cells(i, iResultColumn - iSourceColumn + 1 + j).NumberFormat = "@"
361 | oSourceRange.Cells(i, iResultColumn - iSourceColumn + 1 + j).Value = sResult
362 | Next j
363 | End If
364 | If ActiveWorkbook.Name = Catalog.sFileName And ActiveSheet.Name = Catalog.sSheetName Then
365 | minRow = ActiveWindow.VisibleRange.Row
366 | maxRow = minRow + ActiveWindow.VisibleRange.Rows.Count
367 | If iFirstSourceRow + i <= minRow + 1 Or iFirstSourceRow + i >= maxRow - 1 Then
368 | ActiveWindow.SmallScroll down:=(iFirstSourceRow + i - (maxRow + minRow) / 2) + 1
369 | End If
370 | Application.ScreenUpdating = True
371 | End If
372 | DoEvents
373 | End If
374 | Next i
375 | Application.ScreenUpdating = True
376 | SearchingDialog.Hide
377 | Else
378 | MsgBox ("Invalid Range Selected")
379 | End If
380 | If Catalog.bTerminateLoop Then
381 | LookupDialog.Show
382 | If UserPassForm.RememberCheckbox.Value = False Then
383 | UserPassForm.UserNameBox.Value = ""
384 | UserPassForm.PasswordBox.Value = ""
385 | End If
386 | Else
387 | LookupDialog.ResultTypeList.Clear
388 | End If
389 |
390 | End Sub
391 |
392 | Private Sub OperatorCombo_Change()
393 | If OperatorCombo.Value = "empty" Then
394 | SearchValueBox.Value = "is empty"
395 | SearchValueBox.Enabled = False
396 | ElseIf SearchValueBox.Enabled = False Then
397 | SearchValueBox.Value = ""
398 | SearchValueBox.Enabled = True
399 | End If
400 | End Sub
401 |
402 | Private Sub OtherSourcesButton_Click()
403 | OtherSourcesDialog.Show
404 | End Sub
405 |
406 |
407 | Private Sub RemoveResultButton_Click()
408 | With LookupDialog.ResultTypeList
409 | If .ListIndex > -1 Then
410 | .RemoveItem (.ListIndex)
411 | End If
412 | End With
413 | RedrawButtons
414 | End Sub
415 |
416 | Private Sub RemoveSearchButton_Click()
417 | iSelected = LookupDialog.SearchListBox.ListIndex
418 | If iSelected > -1 Then
419 | LookupDialog.SearchListBox.RemoveItem (iSelected)
420 | End If
421 | If LookupDialog.SearchListBox.ListIndex = -1 Then
422 | LookupDialog.RemoveSearchButton.Enabled = False
423 | LookupDialog.BooleanCombo.Enabled = False
424 | LookupDialog.BooleanCombo.Value = ""
425 | End If
426 | End Sub
427 |
428 | Private Sub RemoveURLButton_Click()
429 | If LookupDialog.CatalogURLBox.ListCount < 2 Then
430 | MsgBox ("Please add another URL before removing the last one")
431 | Exit Sub
432 | End If
433 |
434 | sCatalogURL = LookupDialog.CatalogURLBox.Value
435 | For i = 0 To LookupDialog.CatalogURLBox.ListCount - 1
436 | If sCatalogURL = LookupDialog.CatalogURLBox.List(i) Then
437 | LookupDialog.CatalogURLBox.RemoveItem (i)
438 | LookupDialog.CatalogURLBox.ListIndex = 0
439 | Exit For
440 | End If
441 | Next i
442 | Catalog.RemoveURLfromRegistry (sCatalogURL)
443 | End Sub
444 |
445 | Private Sub ResultColumnSpinner_Change()
446 | LookupDialog.ResultColumnInput.Value = Catalog.ColumnLetterConvert(LookupDialog.ResultColumnSpinner.Value)
447 | End Sub
448 |
449 | Private Sub ResultTypeCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
450 | If KeyCode = vbKeyReturn Then
451 | AddResultButton_Click
452 | KeyCode = 0
453 | End If
454 | End Sub
455 |
456 | Private Sub ResultTypeList_Change()
457 | RedrawButtons
458 | End Sub
459 |
460 |
461 | Private Sub SaveSetButton_Click()
462 | If LookupDialog.FieldSetList.ListIndex < 0 Then
463 | MsgBox ("Please select a set name")
464 | Exit Sub
465 | End If
466 | bSuccess = Catalog.SaveFieldSet(LookupDialog.FieldSetList.Value)
467 | End Sub
468 | Private Sub SearchFieldCombo_Change()
469 | sField = LookupDialog.SearchFieldCombo.Value
470 | If sField = "Other fields..." Then
471 | AdditionalFieldsDialog.FilterBox.Value = ""
472 | If Not IsNull(aExplainFields) Then
473 | AdditionalFieldsDialog.SRUFields.List = aExplainFields
474 | AdditionalFieldsDialog.Show
475 | End If
476 | End If
477 | End Sub
478 |
479 | Private Sub SearchFieldCombo_AfterUpdate()
480 | Catalog.PopulateOperatorCombo
481 | End Sub
482 |
483 | Private Sub SearchListBox_Click()
484 | If LookupDialog.SearchListBox.ListIndex > -1 Then
485 | LookupDialog.RemoveSearchButton.Enabled = True
486 | Else
487 | LookupDialog.RemoveSearchButton.Enabled = False
488 | End If
489 | End Sub
490 |
491 | Private Sub SearchValueBox_Change()
492 | If LookupDialog.SearchValueBox.Value <> "" Then
493 | LookupDialog.AddSearchButton.Enabled = True
494 | Else
495 | LookupDialog.AddSearchButton.Enabled = False
496 | End If
497 | End Sub
--------------------------------------------------------------------------------
/src.vba/OtherSourcesDialog.frm:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "OtherSourcesDialog"
2 | Attribute VB_Base = "0{BB66FFEE-9C3E-4C43-BD8A-C2BF4F22362B}{3536AF55-78AD-4A9A-B907-80788E526153}"
3 | Attribute VB_GlobalNameSpace = False
4 | Attribute VB_Creatable = False
5 | Attribute VB_PredeclaredId = True
6 | Attribute VB_Exposed = False
7 | Attribute VB_TemplateDerived = False
8 | Attribute VB_Customizable = False
9 | Private Sub PopulateURLField()
10 | i = OtherSourcesDialog.OtherSourcesListBox.ListIndex
11 | If i = -1 Then
12 | MsgBox ("No source is selected")
13 | Else
14 | sIndex = OtherSourcesDialog.OtherSourcesListBox.List(i, 0)
15 | LookupDialog.CatalogURLBox.Value = sIndex
16 | End If
17 | End Sub
18 | Private Sub CancelButton_Click()
19 | OtherSourcesDialog.Hide
20 | End Sub
21 |
22 |
23 | Private Sub SelectButton_Click()
24 | PopulateURLField
25 | OtherSourcesDialog.Hide
26 | End Sub
27 |
28 | Private Sub OtherSourcesListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
29 | PopulateURLField
30 | OtherSourcesDialog.Hide
31 | End Sub
--------------------------------------------------------------------------------
/src.vba/SearchingDialog.frm:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "SearchingDialog"
2 | Attribute VB_Base = "0{4A38C425-6F39-477D-AE1F-EB5034B1E365}{C265D129-4BA4-404D-873D-19C93062BE57}"
3 | Attribute VB_GlobalNameSpace = False
4 | Attribute VB_Creatable = False
5 | Attribute VB_PredeclaredId = True
6 | Attribute VB_Exposed = False
7 | Attribute VB_TemplateDerived = False
8 | Attribute VB_Customizable = False
9 | Private Sub CancelButton_Click()
10 | Catalog.bTerminateLoop = True
11 | End Sub
--------------------------------------------------------------------------------
/src.vba/UserPassForm.frm:
--------------------------------------------------------------------------------
1 | Attribute VB_Name = "UserPassForm"
2 | Attribute VB_Base = "0{70669C1D-8A3E-46F6-A79A-A12E75EC7E16}{CEDF8C59-17F7-488C-8875-D92AEDBABCE3}"
3 | Attribute VB_GlobalNameSpace = False
4 | Attribute VB_Creatable = False
5 | Attribute VB_PredeclaredId = True
6 | Attribute VB_Exposed = False
7 | Attribute VB_TemplateDerived = False
8 | Attribute VB_Customizable = False
9 | Private Sub CancelButton_Click()
10 | Catalog.bKeepTryingURL = False
11 | UserPassForm.Hide
12 | End Sub
13 |
14 | Private Sub LoginButton_Click()
15 | UserPassForm.Hide
16 | End Sub
--------------------------------------------------------------------------------
/yaz5x64.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/yaz5x64.dll
--------------------------------------------------------------------------------
/yaz5x86.dll:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pulibrary/ExcelAlmaLookup/d0af8d841cd22325ca015f5fec649056ddcfa593/yaz5x86.dll
--------------------------------------------------------------------------------