Skip to content

Instantly share code, notes, and snippets.

@CJHArch
Created January 13, 2015 19:29
Show Gist options
  • Save CJHArch/9e96a1986c21382c2bca to your computer and use it in GitHub Desktop.
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.
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