Run Time Error 9:
Subscript is out of range.
I get this error when I try to run my module of ExportClassifieds.
This giant function works quite well in my older database. When I tried to bring it directly to the new one though. Problems kept coming up. This so far is the second one out of 15 that I could not figure out myself...
Any help would be greatly appreciated.
Subscript is out of range.
I get this error when I try to run my module of ExportClassifieds.
Code:
Public Function ExportClassifieds()
' Oct. 18, 2007
'VARIABLE DECLARATIONS
Dim db As DAO.Database ' this database
Dim rs As DAO.Recordset ' the recordset based on the query
Dim oInDesign As InDesign.Application ' the InDesign CS5 application
Dim oDocument As InDesign.Document ' the document we'll be creating
Dim oPage As InDesign.Page ' the page we're currently on
Dim oDescText As InDesign.TextFrame ' textframe for the classifieds
Dim oPoints As InDesign.InsertionPoints ' insertion points in story of text frame
Dim oPoint As InDesign.InsertionPoint ' Current insertion point
Dim sCategory As String ' temp variable to hold category
Dim sCategNew As String ' temp variable to hold next category
Dim strDivBegin As String ' (SY 01/09) variable for use in removing "<Div>" and "</Div>" codes
Dim strDivEnd As String ' (SY 01/09) variable for use in removing "<Div>" and "</Div>" codes
Dim strBoldBegin As String ' (SY 01/09) variable for use in corretly importing "BOLD" Text
Dim strBoldEnd As String ' (SY 01/09) variable for use in corretly importing "BOLD" Text
Dim strTmp As String ' (SY 01/09) For replacing & (&),   ( ), and " (")
Dim strTmp2 As String ' (DB 10/09) For getting rid of extra "<" codes
Dim words() As String ' (SY 01/09) array for use in corretly importing "BOLD" Text
Dim words2() As String ' (SY 01/09) array for use in corretly importing "BOLD" Text
Dim Divs() As String ' (SY 01/09) array for use in corretly importing "BOLD" Text
Dim DivEnds() As String ' (SY 01/09) array for use in corretly importing "BOLD" Text
Dim i As Integer ' (SY 01/09) integer for stepping through text to remove "<Div>" codes etc.
Dim zap As Boolean ' (DB 10/09) boolean to help remove other "<" codes
'INITIALIZE OBJECTS AND VARIABLES
Set db = CurrentDb ' set the database variable to this database
Set rs = db.OpenRecordset("Query1") ' set the recordset to Query1
Set oInDesign = CreateObject("InDesign.Application.CS5") ' Open InDesign CS5
Set oDocument = oInDesign.Open("M:\0_Peoples Exchange\Classified Ads.Indd") ' Name of InD file (SY REV 01/09)
Set oPage = oDocument.Pages.Item(1) ' set page to the first page of document
strDivBegin = "<div>" ' (SY 01/09)
strDivEnd = "</div>" ' (SY 01/09)
strBoldBegin = "<strong>" ' (SY 01/09)
strBoldEnd = "</strong>" ' (SY 01/09)
sCategory = "Z" ' set temp value to Category (DB 10/09)
'SET THE TEXT BLOCK
Set oDescText = oPage.TextFrames.Add ' create the text frame
oDescText.GeometricBounds = Array(0.575, 0.625, 10.675, 7.825) ' set the boundary for the text frame
Set oPoints = oDescText.ParentStory.InsertionPoints ' get collection of insertion points for writing text
Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point
' LOOP THROUGH RECORDSET, CREATING THE CURRENT CLASSIFIED TEXT FILE
Do While Not rs.EOF 'RecordSet.EndOfFile
' CHECK FOR START OF NEW CATEGORY ' (DB 10/09) This whole section
sCategNew = UCase(rs.Fields("Section"))
If UCase(sCategory) <> UCase(sCategNew) Then ' Check if New Category
oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Dateline") ' set the paragraph style for previous?! text
Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point
oPoint.Contents = vbCr & sCategNew ' Input new category code
Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point
oPoint.Contents = vbCr ' Input 2 <Return>s to make it easier to see
sCategory = sCategNew ' Store new category code for comparision with next
End If
' Work with Ad Text Field
strTmp = rs.Fields("ClassifiedText") ' Copy Ad Text field into strTmp (SY 01/09)
strTmp = Replace(strTmp, "&", "&") ' REPLACE & with & (SY 01/09)
strTmp = Replace(strTmp, " ", " ") ' REPLACE with space (SY 01/09)
strTmp = Replace(strTmp, """, """") ' REPLACE " with " (SY 01/09)
' Gets rid of all the <Div> and </Div>'s ' (SY 01/09)
Divs() = Split(strTmp, strDivBegin) ' (SY 01/09)
strTmp = "" ' (SY 01/09)
For i = 0 To UBound(Divs()) ' (SY 01/09)
If InStr(Divs(i), strDivEnd) Then ' (SY 01/09)
DivEnds() = Split(Divs(i), strDivEnd) ' (SY 01/09)
strTmp = strTmp & DivEnds(0) ' (SY 01/09)
End If ' (SY 01/09)
Next ' (SY 01/09)
'BEFORE OUTPUTTING THE AD TEXT, I NEED TO GET RID OF SOME ANNOYING CODES!! (DB 10/09) This section
'AND DO IT WITHOUT LOSING ALL MY BOLD/UNBOLD COMMANDS
' I will be removing all "<" and ">" and all text in between, but I need
' to keep the Bold and Unbold commands so I will temporarily replace those
' codes with "XXXX" and "YYYY" placeholders respectively.
strTmp = Replace(strTmp, strBoldBegin, "XXXX") ' Replace <STRONG> with XXXX
strTmp = Replace(strTmp, strBoldEnd, "ZZZZ") ' Replace </STRONG> with ZZZZ
strTmp = Replace(strTmp, " ", " ") ' REPLACE double-spaces with single spaces
strTmp = Replace(strTmp, " ", " ") ' REPLACE double-spaces with single spaces (second time takes care of 3 or 4 spaces total)
zap = False ' Initialize Zap as False
strTmp2 = strTmp ' Initialize strTmp2
strTmp = "" ' Initialize strTmp
Do While Len(strTmp2) > 0 ' Step through this process until strTmp is emptied
If Left(strTmp2, 1) = "<" Then ' Make "zap" True - step on without copying the left character
zap = True
Else
If Left(strTmp2, 1) = ">" Then
zap = False ' Make "zap" Falze - step on without copying the left character
Else
If Not zap Then
strTmp = strTmp & Left(strTmp2, 1) ' If "zap" is activated, we don't want to copy the text, otherwise copy it
End If
End If
End If
strTmp2 = Right(strTmp2, Len(strTmp2) - 1) ' Shave the left character off of the string we're working with
Loop
strTmp = Replace(strTmp, "XXXX", strBoldBegin) ' Replace XXXX with <STRONG> (Put them back)
strTmp = Replace(strTmp, "ZZZZ", strBoldEnd) ' Replace ZZZZ with </STRONG> (Put them back)
'Split the temporary string at the space of "<strong>" ' (SY 01/09) This whole section
words() = Split(strTmp, strBoldBegin) ' Breaks text into an array with strBoldBegin being the breakpoint
' AD the first part TEXT not Bold
oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Dateline") ' set the paragraph style for previous?! text
Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point
'Error happens here--> oPoint.Contents = words(0)
'add each section that contains bold
For i = 1 To UBound(words)
words2() = Split(words(i), strBoldEnd)
'after spliting, it should in the form of ***</strong>***
'before </strong>, it is bold
Set oPoint = oPoints.Item(oPoints.Count)
oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item(2) 'Bold
oPoint.Contents = words2(0)
'after</strong>, it is plain
Set oPoint = oPoints.Item(oPoints.Count)
oPoint.AppliedCharacterStyle = oDocument.CharacterStyles.Item(1) 'Plain
oPoint.Contents = words2(1)
Next
Set oPoint = oPoints.Item(oPoints.Count)
oPoint.Contents = vbCr
' output the ad text and a linefeed
' Work with the DATE LINE Field
oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Classified") ' set the paragraph style for previous?! text
Set oPoint = oPoints.Item(oPoints.Count) ' set the current insertion point
oPoint.Contents = vbTab & rs.Fields("Issue Dates") & vbTab & vbCr ' output ^t - issue dates - ^t ^p
rs.MoveNext ' Move to next record
Loop ' Loop back to top
oPoint.AppliedParagraphStyle = oDocument.ParagraphStyles.Item("Dateline") ' set the paragraph style for previous?! text
'CLOSE UP: SAVE CATELOG AND WIPE VARIABLES
oDocument.Save ("M:\0_Peoples Exchange\Classified Ads.indd") 'save document (SY REV 01/09)
rs.Close ' close recordset
db.Close ' close database
Set rs = Nothing ' Explicitly wipe out rs object
Set db = Nothing ' Explicitly wipe out db object
End FunctionThis giant function works quite well in my older database. When I tried to bring it directly to the new one though. Problems kept coming up. This so far is the second one out of 15 that I could not figure out myself...
Any help would be greatly appreciated.
