We Keep Coding

Office.Interop.Word and Lists with SubLevels

I've been scouring the interwebs for documentation leading me to be able to create lists. In doing so, I've not really been able to find any documentation that will allow me to create `lists within lists.
I've tried using the built-in macro recorder, but for whatever reason, it behaves differently when recording vs. when not recording (e.g. when I create a list item, and hit enter + tab, it doesn't create a sub list).
I've found "The Wordmeister's" MSDN post which helped me get to making a list, but lists within lists doesn't work so well for me.
Word.Paragraph p2 = doc.Paragraphs.Add();
Word.Range p2rng = p2.Range;
object oTrue = true;
object oFalse = false;
object oListName = "TreeList";
Word.ListTemplate lstTemp = doc.ListTemplates.Add(ref oTrue, ref oListName);
int l;
p2rng.ParagraphFormat.TabIndent(1);
p2rng.Text = "Rates:\r\nLevel 1\rLevel 1.1\rLevel 1.2\rLevel 2\rLevel 2.1\rLevel 2.1.1";
l = 1;
lstTemp.ListLevels[l].NumberFormat = "%" + l.ToString() + ".";
lstTemp.ListLevels[l].NumberStyle = Word.WdListNumberStyle.wdListNumberStyleArabic;
lstTemp.ListLevels[l].NumberPosition = wordApp.CentimetersToPoints(0.5f * (l - 1));
lstTemp.ListLevels[l].TextPosition = wordApp.CentimetersToPoints(0.5f * l);
l = 2;
lstTemp.ListLevels[l].NumberFormat = "%" + (l - 1).ToString() + ".%" + l.ToString() + ".";
lstTemp.ListLevels[l].NumberStyle = Word.WdListNumberStyle.wdListNumberStyleArabic;
lstTemp.ListLevels[l].NumberPosition = wordApp.CentimetersToPoints(0.5f * (l - 1));
lstTemp.ListLevels[l].TextPosition = wordApp.CentimetersToPoints(0.5f * l);
l = 3;
lstTemp.ListLevels[l].NumberFormat = "%" + (l - 2).ToString() + "%" + (l - 1).ToString() + ".%" + l.ToString() + ".";
lstTemp.ListLevels[l].NumberStyle = Word.WdListNumberStyle.wdListNumberStyleArabic;
lstTemp.ListLevels[l].NumberPosition = wordApp.CentimetersToPoints(0.5f * (l - 1));
lstTemp.ListLevels[l].TextPosition = wordApp.CentimetersToPoints(0.5f * l);
object oListApplyTo = Word.WdListApplyTo.wdListApplyToWholeList;
object oListBehavior = Word.WdDefaultListBehavior.wdWord10ListBehavior;
p2rng.ListFormat.ApplyListTemplate(lstTemp, ref oFalse, ref oListApplyTo, ref oListBehavior);
All credit to Cindy Meister for this code, it is only slightly modified to work for my use case.
The above results in the following:
Basically, how do you create multi level lists (like the following image) with lists within lists?

It's not really possible to create a "list within a list" in Word.
What you can do is put static text in the list level, in front of the dynamic number. This is the same idea as using "Chapter" or "Section" in front of the level's number, except in this case it should be a bullet symbol.
The place to define this, based on the code sample in the question, is:
lstTemp.ListLevels[l].NumberFormat = "%" + l.ToString() + ".";
As part of the NumberFormat string, in other words. For symobls this will require a conversion from unicode hex or decimal to the String data type. For example, for a solid, round bullet and an outline, round bullet for levels 1 and 2, respectively (hard-coding the list level for purposes of clarity):
char Symbol1 = (char)9679;
char Symbol2 = (char)9675;
lstTemp.ListLevels[1].NumberFormat = Symbol1.ToString() + "\t%" + l.ToString() + ".";
lstTemp.ListLevels[2].NumberFormat = Symbol2.ToString() + "\t%" + 2.ToString() + ".";

Lets try providing an answer that doesn't get deleted.
The updated list within lists example provided by #Jaberwocky can be achieved using the technique I explained in a previous post.
MS-Word: Cross reference to custom reference type
To apply the above to the specific instance required by #Jaberwock we need to amend the number formats of the list templates to which styles are linked. I'll use Word to set up the styles and required multilevel list and then include a short VBA macro which shows how to amend the list number format.
In line with the link above we first need to create our styles. The emulate the list within list example above we need to define two styles. I've defined 'ListWithinList 1' and 'ListWithinList 2'.
The key settings for these two styles are to set the outline level as 1 and 2 respectively, and to set appropriate tab stops. I've used tabs at 1,2,3 and 4 cm. Add some text to a word document and apply the styles. I've included the navigation pane in the picture below so that we can see the indentation due to the outline level of the styles
The next step is to define the multilevel list and link each level to the relevant style
Settings for outline level 1
settings for outline level 2
Our text now looks like this
I've used Word up to this point to avoid the tediousness of setting up styles and list templates programatically.
Let's now modify the format of the list numbering using a snippet of VBA.
Option Explicit
Public Sub AddTextToListNumber()
Dim my_prefix(1 To 2) As String
Dim my_index As Long
my_prefix(1) = ChrW(&H25AA) & vbTab ' small black square
my_prefix(2) = ChrW(&H25AB) & vbTab ' small white square
For my_index = 1 To 2
With ActiveDocument.Styles("ListWithinList " & CStr(my_index)).ListTemplate.ListLevels(my_index)
.numberformat = my_prefix(my_index) & .numberformat
End With
Next
End Sub
If we run the code above then the text in our document becomes
Which looks a bit ugly because of the 1cm tab stops.
If there is anything that isn't clear above please add a comment and if possible I'll update the answer.
NOTE: We didn't need the VBA code to complete setting up the list formats as we could have used appropriate Alt+XXXX keyboard sequences to insert the characters in the number format box of the multilevel list dialog box.

C# Crystal Reports Removing Duplicates

I am generating a report base on projects and their data, the original result for this is:
But as you can see there are a lot of duplicates...
I resolved this by using the following formula in the section expert for supressing:
{Projecten1.Project ID} = next({Projecten1.Project ID})
Now the result is:
This is exactly what I want it to be however, the prices are no longer correct...
I would like the prices to add up if there are duplicates so that:
160629 = 2312,5
170109 = 125,0
The current formula I have for the prices is:
if {Gegevens1.OpLocatie} = 1 and(DATE(ToText({Gegevens1.Datum}, "dd/MM/yyyy")) >= DATE({?ParStart}) and DATE(ToText({Gegevens1.Datum}, "dd/MM/yyyy")) <= DATE({?ParStop})) Then
(ToNumber({#fUren}) * {?ParTariefLocatie}) + {#fBerekeningen} + {#fKM}
Else if {Gegevens1.OpLocatie} = 0 and (DATE(ToText({Gegevens1.Datum}, "dd/MM/yyyy")) >= DATE({?ParStart}) and DATE(ToText({Gegevens1.Datum}, "dd/MM/yyyy")) <= DATE({?ParStop})) Then
(ToNumber({#fUren}) * {?ParTariefKantoor}) + {#fBerekeningen} + {#fKM}
Else
0
In case you are wondering, the prices are linked to the data (hours worked) for each project, like this:
So that's why it's duping the projects
Is there any way to remove the duplicates AND add up the prices if there are duplicates?
Thanks

You can use Group expert and Running total by using the created Group.
1. right click blank white section of your report > Report > Group Expert.
2. create new in running total.
3.select field to summarize.
4.Sum
5.for each record.
6.on group change.

Reading Specific Byte data From File

I have an 8mb file which contains some records.
I want to read a particular record from a particular place.
I have the starting and ending byte index of every record in the file.
My problem is how to use a file dialog box to select the particular file and make a function that reads the file and then stores a particular record in the textbox.
I also have a doubt on how to read all the records at one time in all the textboxes.

First,I need an index of my file values suppose product id =id09876543 location =india then index values of id09876543 is " 12 to 23 "
then i will pass 12 and 23 in function calling.
make a user define function called "read_value" pass the 2 argument in it in integer form and make function as string i.e. it will return value in string format.
call that function in your specific place where you want the answer.
like this.
1)
Public Function read_value(ByVal strat As Integer, ByVal end1 As Integer) As String
Dim fs As FileStream = New FileStream(f_name, FileMode.Open, FileAccess.Read)
Dim n As Integer = 0
Dim s As String = Nothing
Dim i As Integer = 0
Dim l As Long = strat
fs.Seek(l, SeekOrigin.Begin)
'Seek(strat)
For i = strat To end1
n = fs.ReadByte()
s = s + Convert.ToChar(n)
Next
Return s
End Function
Dim ofd1 As New OpenFileDialog
' Dim file_name As String
Try
If ofd1.ShowDialog = Windows.Forms.DialogResult.OK Then
f_name = ofd1.FileName
product_id_txt.Text = read_value(12, 23)
location_txt.Text = read_value(34, 50)
form.Show()
End If
Catch ex As Exception
MessageBox.Show("File Not Found")
End Try
Output of this code is
label----->Product Id: id09876543 <---- this is my text box value

Merging PDFs programatically while maintaining the "Combine files..." bookmark structure?

I originally asked this on Adobe's forums but yet to receive any reponses.
I have to merge a set of many (100+) PDF files into a single report on a weekly basis, and so far, I have been doing the process by hand by selecting the files, right clicking, and selecting "Combine supported files in Acrobat". What I would like to do is replicate this exact same process programmatically (preferrably in Excel/VBA, but C# or Batch commands are acceptable alternatives). I currently have code that will combine pdf files, but it it does not keep the bookmark structure the same way that "Combine supported files in Acrobat" does.
In other words, say I have three files called "A.pdf", "B.pdf", and "C.pdf", and each file contains two bookmarks called "Bkmrk 1" and "Bkmrk 2". I want to programatically combine these three files into a single file that has 9 bookmarks that look like the structure below:
A
Bkmrk 1
Bkmrk 2
B
Bkmrk 1
Bkmrk 2
C
Bkmrk 1
Bkmrk 2
I at first tried automating the process via the Acrobat SDK, but from what I understand the Acrobat SDK does not allow programs to interact with the dialog box that appears when you execute the "Combine Files" menu option, so that did not work. I also tried the option to programatically insert pages from one pdf file into another, but that does not produce the bookmark structure that I am looking for, nor does it let me manipulate the bookmark heirarchy to create the bookmark structure I am looking for.
Does anyone have an idea of how to do this? Any help would be greatly appreciated!

This was pure hell to get working, so I'm happy to share what I've got. This was adapted from code I found here, and will merge files, and put bookmarks at each merge point:
Private mlngBkmkCounter As Long
Public Sub updfConcatenate(pvarFromPaths As Variant, _
pstrToPath As String)
Dim origPdfDoc As Acrobat.CAcroPDDoc
Dim newPdfDoc As Acrobat.CAcroPDDoc
Dim lngNewPageCount As Long
Dim lngInsertPage As Long
Dim i As Long
Set origPdfDoc = CreateObject("AcroExch.PDDoc")
Set newPdfDoc = CreateObject("AcroExch.PDDoc")
mlngBkmkCounter = 0
'set the first file in the array as the "new"'
If newPdfDoc.Open(pvarFromPaths(LBound(pvarFromPaths))) = True Then
updfInsertBookmark "Test Start", lngInsertPage, , newPdfDoc
mlngBkmkCounter = 1
For i = LBound(pvarFromPaths) + 1 To UBound(pvarFromPaths)
Application.StatusBar = "Merging " & pvarFromPaths(i) & "..."
If origPdfDoc.Open(pvarFromPaths(i)) = True Then
lngInsertPage = newPdfDoc.GetNumPages
newPdfDoc.InsertPages lngInsertPage - 1, origPdfDoc, 0, origPdfDoc.GetNumPages, False
updfInsertBookmark "Test " & i, lngInsertPage, , newPdfDoc
origPdfDoc.Close
mlngBkmkCounter = mlngBkmkCounter + 1
End If
Next i
newPdfDoc.Save PDSaveFull, pstrToPath
End If
ExitHere:
Set origPdfDoc = Nothing
Set newPdfDoc = Nothing
Application.StatusBar = False
Exit Sub
End Sub
The insert-bookmark code... You would need to array your bookmarks from each document, and then set them
Public Sub updfInsertBookmark(pstrCaption As String, _
plngPage As Long, _
Optional pstrPath As String, _
Optional pMyPDDoc As Acrobat.CAcroPDDoc, _
Optional plngIndex As Long = -1, _
Optional plngParentIndex As Long = -1)
Dim MyPDDoc As Acrobat.CAcroPDDoc
Dim jso As Object
Dim BMR As Object
Dim arrParents As Variant
Dim bkmChildsParent As Object
Dim bleContinue As Boolean
Dim bleSave As Boolean
Dim lngIndex As Long
If pMyPDDoc Is Nothing Then
Set MyPDDoc = CreateObject("AcroExch.PDDoc")
bleContinue = MyPDDoc.Open(pstrPath)
bleSave = True
Else
Set MyPDDoc = pMyPDDoc
bleContinue = True
End If
If plngIndex > -1 Then
lngIndex = plngIndex
Else
lngIndex = mlngBkmkCounter
End If
If bleContinue = True Then
Set jso = MyPDDoc.GetJSObject
Set BMR = jso.bookmarkRoot
If plngParentIndex > -1 Then
arrParents = jso.bookmarkRoot.Children
Set bkmChildsParent = arrParents(plngParentIndex)
bkmChildsParent.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
Else
BMR.createchild pstrCaption, "this.pageNum= " & plngPage, lngIndex
End If
MyPDDoc.SetPageMode 3 '3 — display using bookmarks'
If bleSave = True Then
MyPDDoc.Save PDSaveIncremental, pstrPath
MyPDDoc.Close
End If
End If
ExitHere:
Set jso = Nothing
Set BMR = Nothing
Set arrParents = Nothing
Set bkmChildsParent = Nothing
Set MyPDDoc = Nothing
End Sub
To use:
Public Sub uTest_pdfConcatenate()
Const cPath As String = "C:\MyPath\"
updfConcatenate Array(cPath & "Test1.pdf", _
cPath & "Test2.pdf", _
cPath & "Test3.pdf"), "C:\Temp\TestOut.pdf"
End Sub

You might need to consider a commercial tool such as Aspose.Pdf.Kit to get the level of flexibility you're after. It does support file concatenation and bookmark manipulation.
There's a 30 day unlimited trial so you can't really lose out other than time if it doesn't work for you.

Use iText# (http://www.itextpdf.com/). imho it is one of the best PDF-tools around. A code to do (approximately) what you want can be found here http://java-x.blogspot.com/2006/11/merge-pdf-files-with-itext.html
Do not worry that all examples talk about Java, the classes and functions are the same in .NET
hth
Mario

Docotic.Pdf library can merge PDF files while maintaining outline (bookmarks) structure.
There is nothing special should be done. You just append all documents one after another and that's all.
using (PdfDocument pdf = new PdfDocument())
{
string[] filesToMerge = ...
foreach (string file in filesToMerge)
pdf.Append(file);
pdf.Save("merged.pdf");
}
Disclaimer: I work for Bit Miracle, vendor of the library.

The Acrobat SDK does let you create and read bookmarks. Check your SDK API Reference for:
PDDocGetBookmarkRoot()
PDBookmark* (AddChild, AddNewChild, GetNext, GetPrev... lots of functions in there)
If the "combine files" dialog doesn't give you the control you need, make your own dialog.

converting from access to MARC and back

i have a access files with details about book and i need to take the details and turn them to a marc record and vice versa. how is the best way to do it?

I released the code for my MARC implementation in C#. To do the actual coding, you will need to refer to the Library of Congress's MARC page most likely.
http://sourceforge.net/projects/marclibrary/
If you use the library, please don't hesitate to provide me feedback!
Mark

I doubt that you'll find anything that will get you there in one jump. Your best bet is most likely going to involve reading the records from Access using your favorite data access technique and then pumping it into something that speaks MARC. I haven't used it, but the MARCNet project looks promising. The MARC format isn't that difficult to implement by hand (it's all just text flat-files at heart), but a lot depends on who you are going to end up talking to and how picky they are.

FWIW, here is some code I wrote ten years ago I used process MARC and put them into an access database.
It's been a LONG time since I looked at this, but I would imagine this could be a start:
'IMPORTANT NOTE: The Marc Record's directory (this is a feature located within a Marc
' Record used to parse the record) uses option base 0 to list
' its positions for the varying fields. (See http://lcweb.loc.gov/marc)
' For example, in "Chumbawumba" the letter "C" would be in the zero position
' On the other hand, VB's Instr() function uses option base 1 to
' determine positions in a variable. ("C" is in position 1).
' Code has been adjusted to reflect this difference.
Option Explicit
Option Base 0
Const Marc21_Blank = " " 'Chr(32) Hex 20
Const Marc21_Delimiter = "" 'Chr(31) Hex 1F
Const Marc21_FieldTerminator = "" 'Chr(30) Hex 1E
Const Marc21_RecordTerminator = "" 'Chr(29) Hex 1D
Const Marc21_FillChar = "|" 'Chr(124) Hex 7C
Const Marc21_DirLength = 12 'Length of 1 direcotry Entry (option base 1)
Const Marc21_DirLengthOfFieldPos = 3 'Where the "Length of Field" number can be found in
'one directory entry (by MARC definition)
Const Marc21_DirLengthOfFieldLength = 4 'The physical length of the "Length of Field" entry
'Found in the directory
Const Marc21_DirStartingPos = 7 'Where the "Length of Field" number can be found in
'one directory entry (by MARC definition)
Const Marc21_DirStartingPosLength = 5 'The physical length of the "Length of Field" entry
'Found in the directory
Const Marc21_DirTagLength = 3 'The physical length of the "Length of Field" entry
Const Marc21_LdrLength = 24 'Length of Leader (option base 1)
Const Marc21_PositionAdjustment = 1 'Adjustment constant for Marc record (see note at top of module)
Const Marc21_FieldTerminatorPos = 1 'Represents a place for field terminator
Const Marc21_MaxControlFieldTagValue = 9 'Tags for control fields range from "001" to "009"
Const Marc21_IndicatorLength = 1 'Length of indicator
Const Marc21_MovePastIndicators = 3 'After indicators are stored in a variable field
'we should move past them to the new starting position
'This new position will be a delimeter for a variable field
Const Marc21_MovePastSubfieldCode = 2 'Used to move past the delimeter and subfield code in a varible field
'Const Marc21_FieldCount = 1 'Number of fields in Directory (option base 0)
Dim mrsLeaders As Recordset 'Recordset storing Leaders from the Marcs Imported
Dim mrsTags As Recordset 'Recordset storing the Tags
Dim mrsFields As Recordset 'Recordset storing the different variable fields in the data
'***********************************************************************************************************************
' PROCEDURE: ProcessRecord_S
'
' PURPOSE: From the text file passed, this sub will parse the Marc records
' and individually send them to the subsequent modules for further parsing
'
'PARAMETERS: sFile -- contains full path and filename of text file passed
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Sub ProcessRecord_S(sFile As String)
Dim iFreeFile As Integer
Dim vMarc As Variant
Dim lRTPos As Long
Dim sMarcRecord As String
Dim dbMarc As Database
Set dbMarc = OpenDatabase("D:\Marc21\marc21.mdb")
'Made these recordsets modular because I step into two functions saving the information.
'In addition, the text file could hold thousands of records (that's a lot of loops).
Set mrsLeaders = dbMarc.OpenRecordset("Select * From NewLeaders")
Set mrsTags = dbMarc.OpenRecordset("Select * From NewTags")
Set mrsFields = dbMarc.OpenRecordset("Select * From NewFields")
lRTPos = 0 'Initialize
iFreeFile = FreeFile 'Get an available Free file number
Open sFile For Input As #iFreeFile 'Open the text file.
vMarc = Input$(LOF(iFreeFile), iFreeFile) 'Not sure what the limit is, but I have
Close #iFreeFile 'tested data as big as 10 megs.
Do Until vMarc = "" 'Going to loop till the variant is turned into an empty string
lRTPos = InStr(vMarc, Marc21_RecordTerminator) 'Since there can be more than one MarcRecord, we will use the position of the
'Record Terminator (RT) to determine where the Marc Record ends
sMarcRecord = Left(vMarc, lRTPos - 1) 'Record minus RT
If Not SaveRecord_F(sMarcRecord) Then
MsgBox "Saving Marc Record Failed"
Exit Sub
End If
vMarc = Mid(vMarc, lRTPos + 1)
Loop
End Sub
'***********************************************************************************************************************
' PROCEDURE: SaveRecord_F
'
' PURPOSE: Saves tags and indicators (if applicable) to the Tag table
'
'PARAMETERS: sMarcRecord -- Marc Record passed (this string can be up to 99,999 characters long)
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Function SaveRecord_F(sMarcRecord As String)
Dim sLeader As String * 24
Dim sDirectory As String 'Whole Directory
Dim sVarFields As String 'All Control and Data Fields
Dim lDirectoryEnd As Long 'Position where Directory ends
Dim lDataEntries As Long 'Determines number of Field Entries
Dim lFieldLength As Long
Dim lStartingPosition As Long
Dim lLeaderID As Long
Dim lTagID As Long
Dim sField As String
Dim sDirectoryEntry() As String
Dim bControl As Boolean
Dim lCurDirEntry As Long
Const Marc21_FLP = 4 'Field Length position relative to directory
sLeader = Left(sMarcRecord, Marc21_LdrLength) 'Set Leader
lDirectoryEnd = InStr(Marc21_LdrLength + 1, sMarcRecord, Marc21_FieldTerminator) - Marc21_FieldTerminatorPos 'Set position for end of Directory (excluding FT)
sDirectory = Mid(sMarcRecord, Marc21_LdrLength + 1, lDirectoryEnd - Marc21_LdrLength) 'Set Directory minus field terminator
'Set Variable Fields by taking end of directory position, adding one
'for the FT position and then adding another "1" to mark the beginning of the
'vfields
sVarFields = Mid(sMarcRecord, lDirectoryEnd + Marc21_FieldTerminatorPos + 1)
lDataEntries = Len(sDirectory) 'Get Length of Directory
'Make sure Directory Length Matches with Marc21 Records
If lDataEntries Mod Marc21_DirLength <> 0 Then
MsgBox "Directory Entries are messed up"
Exit Function
End If
'Add Leader to Leader Table
mrsLeaders.AddNew
lLeaderID = mrsLeaders!LeaderID 'Need this newly assigned ID to process info below
mrsLeaders!leader = sLeader
mrsLeaders.Update
'Get Number of Directory Entries for this Marc Record
lDataEntries = lDataEntries / Marc21_DirLength
'Store Tag information and, while still looping, store Variable Field Info pertaining
'to TagID pertaining to Leader
For lCurDirEntry = 0 To lDataEntries - 1
'Starting Position of Field Entry
lStartingPosition = Val(Mid(sDirectory, lCurDirEntry * Marc21_DirLength + Marc21_DirStartingPos + Marc21_PositionAdjustment, Marc21_DirStartingPosLength))
'Field length in directory relative to current record
lFieldLength = Val(Mid(sDirectory, (lCurDirEntry * Marc21_DirLength) + Marc21_DirLengthOfFieldPos + Marc21_FieldTerminatorPos, Marc21_DirLengthOfFieldLength))
mrsTags.AddNew
mrsTags!LeaderID = lLeaderID
'According to MARC, the tag within a directory starts at position zero, so we adjust it by one for the MID function
mrsTags!Tag = Mid(sDirectory, lCurDirEntry * Marc21_DirLength + Marc21_PositionAdjustment, Marc21_DirTagLength)
'Set indicators for Data Fields (non-control fields)
If Val(mrsTags!Tag) > Marc21_MaxControlFieldTagValue Then
mrsTags!Indicator1 = Mid(sVarFields, lStartingPosition + 1, Marc21_IndicatorLength)
mrsTags!Indicator2 = Mid(sVarFields, lStartingPosition + 2, Marc21_IndicatorLength)
lStartingPosition = lStartingPosition + Marc21_MovePastIndicators
lFieldLength = lFieldLength - Marc21_MovePastIndicators 'Adjust field length accordingly
bControl = False
Else
lStartingPosition = lStartingPosition + Marc21_PositionAdjustment 'Adjusted b/c Marc21's defines positions of fields based on position zero. VB uses base 1. Imagine that.
bControl = True
End If
lTagID = mrsTags!TagID
'mrsTags!FieldDesc = Mid(sVarFields, lStartingPosition + 1, lFieldLength - 1) 'Directory Entry - Field Termintor (FT)
mrsTags.Update
'Only Get field pertaining to Direcotry Entry Just Saved
sField = Mid(sVarFields, lStartingPosition, lFieldLength)
SaveFields_F sField, lTagID, bControl 'Adding and Subtracting two is accounting for indicators
Next lCurDirEntry
SaveRecord_F = True
End Function
'***********************************************************************************************************************
' PROCEDURE: SaveFields_F
'
' PURPOSE: Saves the variable data and control fields to its respective table
'
'PARAMETERS: sField -- The data which must be filtered
' lTagID -- The unique identifier related to the records about to be stored
' bControl -- Optional. Let's sub know if data is a control field or not
'
'
' Date: Name: Description:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 03/06/01 Ray Initial Creation
'***********************************************************************************************************************
Function SaveFields_F(sField As String, lTagID As Long, Optional bControl As Boolean)
Dim lDelimeterPos As Long
If Not bControl Then 'Not a control Field
If Left(sField, 1) = Marc21_Delimiter Then
sField = Mid(sField, 2) 'Move past delimeter
Else
'All non-control fields should start with delimeters
MsgBox "This entry didn't start out with a delimeter", vbOKOnly, "Uh Oh"
Exit Function
End If
lDelimeterPos = InStr(1, sField, Marc21_Delimiter)
Do Until lDelimeterPos = 0
'Store new subfield code and field description
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!SubFieldCode = Left(sField, 1)
mrsFields!FieldDesc = Mid(sField, Marc21_MovePastSubfieldCode, lDelimeterPos - Marc21_MovePastSubfieldCode) 'Start at position two b/c of subfield code. Subtract by 2 b/c of where started
mrsFields.Update
sField = Mid(sField, lDelimeterPos + 1)
'Get new delimeter position
lDelimeterPos = InStr(1, sField, Marc21_Delimiter)
Loop
If sField <> "" Then
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!SubFieldCode = Left(sField, 1)
mrsFields!FieldDesc = Mid(sField, Marc21_MovePastSubfieldCode)
mrsFields.Update
End If
Else
If sField <> "" Then
If Right(sField, 1) = Marc21_FieldTerminator Then
sField = Mid(sField, 1, Len(sField) - Marc21_FieldTerminatorPos)
End If
mrsFields.AddNew
mrsFields!TagID = lTagID
mrsFields!FieldDesc = sField
mrsFields.Update
End If
End If
End Function
The access database I created (and used) can be found here.