URGENT - Need modification to ole export function

I have been experimenting with an mdb from Stephen Lebans to export a large number of ole objects from a database. It is without doubt superb, but I need to modify a field in each row to indicate where the file has been saved so I can use the output to still open the documents from the database.

Here's the code

What I need to do is update a field called DocPath to reflect where the document has been saved, but I have no idea how to achieve this, can anyone help.

Code is from http://www.lebans.com/oletodisk.htm (Stephen Lebans) take a trip there it has some excellent tools.

Thank you in advance

Private Sub ExportOLE()

' Array of Bytes to hold the contents of the OLE field
Dim a() As Byte
' For copy of OLE field before processing. Use to debug
' and examine new/unsupported objects.
Dim b() As Byte

' Temp vars
Dim x As Long
Dim lTemp As Long
Dim sl As String
Dim blRet As Boolean
Dim lngRet As Long
Dim DocPath As String

' File extension of OLE object
Dim sExt As String

' Load our Structured Storage Library
' Let's see if the StrStorage.DLL is available.
blRet = LoadLib()
If blRet = False Then
    ' Cannot find StrStorage.dll file
    Exit Sub
End If

' Create instance of cDIBSection in the modGetContentsStream module
'Dim ds As New cDIBSection
CreateDS

' Counter
Dim lTotalRecsExported As Long

On Error GoTo ERR_export

' This is an optional param we pass to fGetContentsStream.
' It will contain the original file name of the
' object when embedded as a Package.
Dim PackageFileName As String
' File number
Dim iFileHandle As Integer

' DAO object handles
Dim dbCurrent As daO.Database
Dim rs As daO.Recordset

lTotalRecsExported = 0

' Open the MDB
Set dbCurrent = OpenDatabase(MDBName, False, True)
' Open the recordset
Set rs = dbCurrent.OpenRecordset(TableName, dbOpenDynaset, dbReadOnly)

' Move to the first record
rs.MoveFirst

' Loop while not at EOF
Do While Not rs.EOF

    ' Make sure there is data in this record.
    lTemp = rs.Fields(OLEFieldName).FieldSize
    If lTemp > 0 Then
     
        ' Size our arays
        ReDim a(0 To lTemp - 1)
        ReDim b(0 To lTemp - 1)
       
        ' Copy the contents of the OLE field to our byte array
        a = rs.Fields(OLEFieldName).Value
        ' Make a copy
        b = a
       
        ' Make a  Call our function to extract the contents of the field
        PackageFileName = ""
        blRet = fGetContentsStream(a(), sExt, PackageFileName)
       
        ' Skip saving to disk if unsupported object type
        ' or fail on return
        If blRet = True Then

            ' Increment counter
            lTotalRecsExported = lTotalRecsExported + 1
           
           
            ' If a file was dragged from the Explorer window
            ' it will have a Package object Filename of NULL
            ' inserted by Shell.DLL
            ' Catch and give a temp file name
           
            If sExt = "pak" Then
                If Len(PackageFileName & vbNullString) < 3 Then
                    PackageFileName = rs.Fields(NameField).Value & "." & "bmp"
               
                End If
               
                ' Package object
                sl = SaveFolderName & "\" & PackageFileName
                'for debugging "C:\sourcecode\OLEdatatestfiles\"
            Else
                ' File Name derived from field user chose to "name" output files.
                sl = SaveFolderName & "\" & rs.Fields(NameField).Value & "." & sExt

            End If
           
   
            ' Write to disk
            iFileHandle = FreeFile
            Open sl For Binary Access Write As iFileHandle
            Put iFileHandle, , a
            Close iFileHandle
           
                ' Write original filed all debug
'                iFileHandle = FreeFile
'                Open sl & "DEBUG" For Binary Access Write As iFileHandle
'                Put iFileHandle, , b
'                Close iFileHandle
       
        End If
       
    ' Jump here if the OLE field for this record was empty
    End If
         
        ' Move to next record
        rs.MoveNext
       
        ' Update our Status Label
        Me.lblUpdate.Caption = "Exporting Record:" & rs.AbsolutePosition + 1 & _
        " of " & rs.RecordCount
        DoEvents
        ' Check our Flag
        If blExporting = False Then
            ' Exit this loop
            Exit Do
        End If
   
Loop

If blExporting = False Then
    ' Update our Status Label
    Me.lblUpdate.Caption = "Export Halted. " & lTotalRecsExported & " Records Exported!"
Else
    ' Update our Status Label
    Me.lblUpdate.Caption = "Export Completed. " & lTotalRecsExported & " Records Exported!"
End If


EXIT_export:
Set rs = Nothing
dbCurrent.Close
Set dbCurrent = Nothing
' Free our instance of cDIBSection
FreeDS

' Release structured storage library
UnLoadLib
Exit Sub

' Cleanup
ERR_export:

Resume EXIT_export
End Sub
martmacAsked:
Who is Participating?
 
jefftwilleyCommented:
Nope, you were clear...and this

"sl = SaveFolderName & "\" & rs.Fields(NameField).Value & "." & sExt"

as written in the code is exactly what you were looking for.
The .edit and .update insert that into the field you spoke of as each record is exported.
J

0
 
BPebCommented:
I'm not sure what you're asking, but if it's just what variable do you grab that has the path and filename thats "sl".  You'll need to write code to save to your database table in the same section as you write to disk.   I'd create a function (or sub) to handle the write just to make it easier to read.

            ' Write to disk
            iFileHandle = FreeFile
            Open sl For Binary Access Write As iFileHandle
            Put iFileHandle, , a
            Close iFileHandle
            WriteSavedObjInfo(sl)

0
 
jefftwilleyCommented:
If you're just inserting the path and filename on the fly then you already have that defined in your SL variable. Simply insert it into the field

            If sExt = "pak" Then
                If Len(PackageFileName & vbNullString) < 3 Then
                    PackageFileName = rs.Fields(NameField).Value & "." & "bmp"
               
                End If
               
                ' Package object
                sl = SaveFolderName & "\" & PackageFileName
                'for debugging "C:\sourcecode\OLEdatatestfiles\"
            Else
                ' File Name derived from field user chose to "name" output files.
                sl = SaveFolderName & "\" & rs.Fields(NameField).Value & "." & sExt

            End If

Something to this effect, while the recordset is open.
     rs.edit      
     rs.fields("docpath").value = sl
     rs.update
   
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Rick_RickardsCommented:
*** Step 1)

The first thing we'll need to do is change the following line...

Set rs = dbCurrent.OpenRecordset(TableName, dbOpenDynaset, dbReadOnly)

The line above makes the recordset ReadOnly and we need something that is edibable.  Changing the above line to the line below will do the job.

Set rs = dbCurrent.OpenRecordset(TableName, dbOpenDynaset)

*** Step 2)

Locating the code where you advance to the next record, (listed below), we'll need a new field where int the source table that contains a sring or memo where the file name is to be sotred.

        ' Move to next record
        rs.MoveNext

If the filed name were to be something like, "PathAndFileName" then the code above would be modified to look like this...

        'Log the location where the file was saved
        rs.Edit
        rs.Fields("PathAndFileName").Value = sl
        rs.Update

        ' Move to next record
        rs.MoveNext

*** Finished

That aught to do it.  Good luck.

Rick
0
 
martmacAuthor Commented:
I knew I would have difficulty explaining, so excuse my poor description. I'll try to outline it a little better, but it's worth mentioning that I am struggling to understand the existing code let alone how best to modify it.

The existing code effectively exports ole objects out of my CostLetters Table to a specified Folder on the Hard Disk (C:\Program Files\CMITS\Shared\Documents). It uses the ID field (LetterID) as the filename when exporting the documents. This all works fine and dandy, saving me hours and hours.

At the point when it exports the ole object, I need the code to also update a currently blank field on the same row called DocPath with the path used to export the ole object. For example if the first row has a word document embedded, then it will be exported to C:\Program Files\CMITS\Shared\Documents\-122654354.doc. I need the DocPath field to be updated just to read  \Documents\-122654354.doc. I can then use the path to open the document from it's new location.

I hope this is clearer

Thanks
0
 
jefftwilleyCommented:
Can you show us your version of the code that you're using and we can plug the edit in for you then you can cut and paste.
J
0
 
martmacAuthor Commented:
Thanks Rick, I am almost there, the only problem I have now is that the DocPath field get's updated with the full path C:\Program Files\CMITS\Shared\Documents\documentname. What I need to do is parse this so that all that is recorded is \Documents\documentname. Any suggestions?

Thanks
Martin
0
 
Rick_RickardsCommented:
I think a small alternation to this line....

  rs.Fields("PathAndFileName").Value = sl

will do the job.  Try changing it to...

    rs.Fields("PathAndFileName").Value = Mid(sl, InStr(1, sl, "\Documents\"))

Good luck,

Rick



0
 
martmacAuthor Commented:
You guys are the business, many thanks the problem is solved and I am about to break free from the torture of embedded documents at long last!!!

I have split the points as both of you were saying the same thing, I hope this is OK and I thank you again.

Martin
0
 
Rick_RickardsCommented:
Glad we could help.

Rick
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.