'MacroName:Cnx2XL
'MacroDescription:Copy cataloging data from Connexion to Excel
'Macro created by: Joel Hahn, Niles Public Library District
'Last edited: 5 July 2004

'Before you use this macro for the first time, make sure to create 
'a blank Excel file in which to store the data, and change the 
'file name variable in the macro to the full path of your new 
'Excel file.


Sub Main
  Dim CS As Object
   On Error Resume Next
   Set CS  = GetObject(,"Connex.Client")
   On Error GoTo 0
   If CS  Is Nothing Then
      Set CS  = CreateObject("Connex.Client")
   End If

  'Set the output filename, check for its existence
  sFileName = "C:\catstats.xls"
  If Dir(sFileName) = "" Then
    MsgBox "File not found: " & Chr(10) & Chr(9) & sFileName & Chr(10) & Chr(10) & "Exiting..."
    Exit Sub
  End If

  'Get the author, if there is one
  bool = CS.GetField("100", 1, sAuthor)
  If bool = FALSE Then
    bool = CS.GetField("110", 1, sAuthor)
    If bool = FALSE Then
      bool = CS.GetField("111", 1, sAuthor)
    End If
  End If
  If bool <> FALSE Then
    sAuthor = Mid(sAuthor, 6)
  Else
    sAuthor = ""
  End If
  'Strip out subfield codes
  Do While InStr(sAuthor, Chr(223))
    place = InStr(sAuthor, Chr(223))
    sAuthor = RTrim(Left(sAuthor, place - 1)) & " " & LTrim(Mid(sAuthor, place + 2))
  Loop

  'Get the title
  bool = CS.GetField("245", 1, sTitle)
  sTitle = Mid(sTitle, 6)
  'Remove the statement of responsibility, if there is one
  If InStr(sTitle, Chr(223) & "c") Then
    place = InStr(sTitle, Chr(223) & "c")
    sTitle = RTrim(Left(sTitle, place - 1))
    If Right(sTitle, 1) = "/" Then sTitle = RTrim(Left(sTitle, Len(sTitle) - 1))
  End If
  'Strip out subfield codes
  Do While InStr(sTitle, Chr(223))
    place = InStr(sTitle, Chr(223))
    sTitle = RTrim(Left(sTitle, place - 1)) & " " & LTrim(Mid(sTitle, place + 2))
  Loop

  'Get the OCLC Number  
  bool = CS.GetFixedField("OCLC", sONum)
  
  'Get the Format (Type + BLvl)
  bool = CS.GetFixedField("Type", sRecType)
  bool = CS.GetFixedField("BLvl", sBLvl)
  Select Case sRecType
    Case "a", "t"
      If sBLvl = "s" Then
        sRecFmt = "SER"
      Else
        sRecFmt = "BKS"
      End If
    Case "c", "d"
      sRecFmt = "SCO"
    Case "e", "f"
      sRecFmt = "MAP"
    Case "g", "k", "r", "o"
      sRecFmt = "VIS"
    Case "i", "j"
      sRecFmt = "REC"
    Case "m"
      sRecFmt = "COM"
    Case "p"
      sRecFmt = "MIX"
  End Select

  'Open a new Excel session  
  Dim XL As Object
  Set XL = CreateObject("Excel.Application")
  
  'Display the Excel window
  XL.Visible = TRUE

  'Open the Excel file
  XL.Workbooks.Open sFileName  

  'Find the next empty row
  Dim xlRange as Object
  Set xlRange = XL.Sheets(1).UsedRange
  If xlRange.Rows.Count = 1 And Trim(XL.Sheets(1).Range("B1").Value) = "" Then
    'If the file is empty, set up the column headers
    nNextRow = xlRange.Rows.Count
    XL.Sheets(1).Range("A" & CStr(nNextRow)).Value = "Author"
    XL.Sheets(1).Range("B" & CStr(nNextRow)).Value = "Title"
    XL.Sheets(1).Range("C" & CStr(nNextRow)).Value = "OCLC #"
    XL.Sheets(1).Range("D" & CStr(nNextRow)).Value = "Format"
    XL.Sheets(1).Range("E" & CStr(nNextRow)).Value = "Date Cataloged"
  End If
  nNextRow = xlRange.Rows.Count + 1

  'Write the data into the Excel file, columns A-E
  XL.Sheets(1).Range("A" & CStr(nNextRow)).Value = sAuthor
  XL.Sheets(1).Range("B" & CStr(nNextRow)).Value = sTitle
  XL.Sheets(1).Range("C" & CStr(nNextRow)).Value = sONum
  XL.Sheets(1).Range("D" & CStr(nNextRow)).Value = sRecFmt
  XL.Sheets(1).Range("E" & CStr(nNextRow)).Value = Date$

  'Save and close the file  
  XL.Workbooks(1).Close (TRUE)

  'Close the new Excel session
  XL.Quit
End Sub