Created
January 13, 2015 19:29
-
-
Save CJHArch/9e96a1986c21382c2bca to your computer and use it in GitHub Desktop.
To be run on a directory of files to create a csv for use in ingesting digital files into DigiTool. Run on a spreadsheet with the list of files in column A and extensions in column B. Created for LBI collections with 5-digit AR numbers.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub Digitool_KDP_based_ingest_LBI_AR5() | |
' | |
' This macro will take a basic Karens Directory Printer output and prepare a template for Digitool CSV ingest. 100214 KS with updates by LL for LBI Creekside collections with five digits after the AR 2014-11-21 | |
' | |
' | |
' RenameSheet Macro | |
' | |
' | |
Sheets(ActiveSheet.Name).Select | |
Sheets(ActiveSheet.Name).Name="Sheet1" | |
Range("E31").Select | |
' SortbyFolders | |
' | |
' | |
Columns("B:B").Select | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
Range("B1").Select | |
Application.CutCopyMode = False | |
' NOTE the following MID formula is meant for LBI collections with AR numbers of five digits, e.g. AR 25123. If running this macro on a collection with a 4 digit AR number, change formula to "=MID(RC[-1], 11, 11). For a 3 digit AR number, change to "=MID(RC[-1], 10, 11). For a 2 digit AR number, change to "=MID(RC[-1], 9, 11)”. | |
ActiveCell.FormulaR1C1 = "=MID(RC[-1], 12, 11)" | |
Range("B1").Select | |
Selection.AutoFill Destination:=Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault | |
Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row).Select | |
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row | |
Range("B:B").Select | |
Sheets(ActiveSheet.Name).Sort.SortFields.Clear | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"B1" & ":B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ | |
xlSortNormal | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"C1" & ":C" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ | |
xlSortNormal | |
With Sheets(ActiveSheet.Name).Sort | |
.SetRange Range("A1" & ":C" & LastRow) | |
.Header = xlYes | |
.MatchCase = False | |
.Orientation = xlTopToBottom | |
.SortMethod = xlPinYin | |
.Apply | |
End With | |
' | |
' FixFileOrder | |
' | |
' | |
Columns("B:B").Select | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
Columns("D:D").Select | |
Selection.Cut | |
Columns("B:B").Select | |
ActiveSheet.Paste | |
Columns("C:C").Select | |
Selection.Copy | |
Columns("D:D").Select | |
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ | |
:=False, Transpose:=False | |
Columns("D:D").Select | |
Application.CutCopyMode = False | |
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _ | |
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ | |
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ | |
:="-", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True | |
' | |
' GrabPDFsbyNumber Macro | |
' | |
' | |
Columns("B:B").Select | |
Selection.Copy | |
Columns("J:J").Select | |
ActiveSheet.Paste | |
Range("K2").Select | |
Application.CutCopyMode = False | |
ActiveCell.FormulaR1C1 = "" | |
Columns("J:J").Select | |
Selection.Replace What:="jp2", Replacement:="", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="jpg", Replacement:="", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="jpf", Replacement:="", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="tif", Replacement:="", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="pdf", Replacement:="0", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("A:J").Select | |
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear | |
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("J:J" _ | |
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal | |
With ActiveWorkbook.Worksheets("Sheet1").Sort | |
.SetRange Range("A:J") | |
.Header = xlGuess | |
.MatchCase = False | |
.Orientation = xlTopToBottom | |
.SortMethod = xlPinYin | |
.Apply | |
End With | |
' | |
' FillInRows Macro | |
' | |
Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row).Select | |
Selection.AutoFill Destination:=Range("F1:J" &Range("J" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault | |
Range("F1:J" &Range("J" & Rows.Count).End(xlUp).Row).Select | |
' SelectPDFs Macro | |
' | |
Range("A1:J" & Range("J" & Rows.Count).End(xlUp).Row).Select | |
' | |
' CopyPastePDFS Macro | |
' | |
Sheets.Add After:=Sheets(Sheets.Count) | |
Sheets.Add After:=Sheets(Sheets.Count) | |
Sheets("Sheet1").Select | |
Selection.Copy | |
Sheets("Sheet2").Select | |
ActiveSheet.Paste | |
Sheets("Sheet3").Select | |
ActiveSheet.Paste | |
Range("L18").Select | |
Range("L18").Select | |
' | |
' DeleteExtra0s Macro | |
' | |
' | |
Columns("F:J").Select | |
Selection.Delete Shift:=xlToLeft | |
Sheets("Sheet2").Select | |
Columns("F:J").Select | |
Selection.Delete Shift:=xlToLeft | |
' | |
' PrepPDFlistsforSort Macro | |
Sheets("Sheet2").Select | |
Columns("E:E").Select | |
Application.CutCopyMode = False | |
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _ | |
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ | |
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ | |
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True | |
Sheets("Sheet3").Select | |
Columns("E:E").Select | |
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _ | |
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ | |
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ | |
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True | |
Sheets("Sheet2").Select | |
Columns("F:F").Select | |
Selection.Replace What:="pdf", Replacement:="0", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Sheets("Sheet3").Select | |
Columns("F:F").Select | |
Selection.Replace What:="pdf", Replacement:="0", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Range("J20").Select | |
Sheets("Sheet1").Select | |
ActiveWindow.SmallScroll Down:=-15 | |
Sheets("Sheet2").Select | |
Columns("B:B").Select | |
Selection.Replace What:="pdf", Replacement:="zpart_of", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Sheets("Sheet3").Select | |
Columns("B:B").Select | |
Selection.Replace What:="pdf", Replacement:="manifestation", LookAt:= _ | |
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Range("A1:F" & Range("D" & Rows.Count).End(xlUp).Row).Select | |
Selection.Copy | |
Sheets("Sheet1").Select | |
Rows("1:1").Select | |
Selection.Insert Shift:=xlDown | |
ActiveWindow.SmallScroll Down:=3 | |
Range("A22").Select | |
Sheets("Sheet2").Select | |
Range("A1:F" & Range("D" & Rows.Count).End(xlUp).Row).Select | |
Application.CutCopyMode = False | |
Selection.Copy | |
Sheets("Sheet1").Select | |
Rows("1:1").Select | |
Selection.Insert Shift:=xlDown | |
Columns("A:F").Select | |
Sheets(ActiveSheet.Name).Sort.SortFields.Clear | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ | |
xlSortNormal | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ | |
xlSortNormal | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ | |
xlSortNormal | |
Sheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _ | |
"F:F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ | |
xlSortNormal | |
With Sheets(ActiveSheet.Name).Sort | |
.SetRange Range("A:F") | |
.Header = xlGuess | |
.MatchCase = False | |
.Orientation = xlTopToBottom | |
.SortMethod = xlPinYin | |
.Apply | |
End With | |
Columns("C:F").Select | |
Selection.Delete Shift:=xlToLeft | |
Range("A1").Select | |
Columns("B:B").Select | |
Selection.Copy | |
Columns("C:C").Select | |
ActiveSheet.Paste | |
Columns("B:B").Select | |
Selection.Replace What:="jpg", Replacement:="manifestation", LookAt:= _ | |
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("B:B").Select | |
Selection.Replace What:="jpf", Replacement:="manifestation", LookAt:= _ | |
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("B:B").Select | |
Selection.Replace What:="jp2", Replacement:="manifestation", LookAt:= _ | |
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("B:B").Select | |
Selection.Replace What:="tif", Replacement:="part_of", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("B:B").Select | |
Selection.Replace What:="zpart_of", Replacement:="part_of", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Columns("C:C").Select | |
Selection.Replace What:="jpg", Replacement:="THUMBNAIL", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="jpf", Replacement:="VIEW", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="jp2", Replacement:="VIEW", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="tif", Replacement:="ARCHIVE", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="zpart_of", Replacement:="ARCHIVE", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
Selection.Replace What:="manifestation", Replacement:="VIEW", LookAt:=xlPart, _ | |
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
' | |
' addcolumns Macro | |
' | |
' | |
Columns("B:B").Select | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
Columns("D:D").Select | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
' ItemNumbers Macro | |
' | |
Columns("B:B").Select | |
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove | |
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row | |
' NOTE the following MID formula is meant for LBI collections with AR numbers of five digits, e.g. AR 25123. If running this macro on a collection with a 4 digit AR number, change formula to "= MID(RC[-1],19,3). For a 3 digit AR number, change to "= MID(RC[-1],18,3). For a 2 digit AR number, change to "=MID(RC[-1],17,3)”. | |
Range("B2:B" & LR).FormulaR1C1 = "=(MID(RC[-1],20,3))+0" | |
Range("C2").Select | |
LR = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row | |
Range("C2:C" & LR).FormulaR1C1 = "=CONCATENATE(""Item"","" "",RC[-1])" | |
' | |
' PasteItemValuesDeleteNos Macro | |
' | |
' | |
Columns("C:C").Select | |
Selection.Copy | |
Columns("C:C").Select | |
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ | |
:=False, Transpose:=False | |
Range("I7").Select | |
Application.CutCopyMode = False | |
ActiveCell.FormulaR1C1 = "" | |
Columns("B:B").Select | |
Selection.Delete Shift:=xlToLeft | |
' | |
' AddQuickViewLabel Macro | |
' | |
' | |
Columns("B:B").Select | |
Selection.Replace What:="#VALUE!", Replacement:="Quick view", LookAt:= _ | |
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ | |
ReplaceFormat:=False | |
ActiveWindow.SmallScroll Down:=-9 | |
Columns("A:A").Select | |
Selection.FormatConditions.Delete | |
' | |
' add new row and row names | |
' | |
Rows("1:1").Select | |
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove | |
[A1].Value = "filename" | |
[B1].Value = "label" | |
[C1].Value = "relation type" | |
[D1].Value = "vpid" | |
[E1].Value = "relations" | |
[F1].Value = "entity_type" | |
[G1].Value = "usage_type" | |
' | |
' DeleteExtraSheets Macro | |
' | |
' | |
Sheets("Sheet2").Select | |
ActiveWindow.SelectedSheets.Delete | |
Sheets("Sheet3").Select | |
ActiveWindow.SelectedSheets.Delete | |
' DeleteHIJZerosAtEnd Macro | |
' | |
' | |
Columns("H:J").Select | |
Selection.ClearContents | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment