S
sjlevine34
We have over 500 documents that are associated with records in an
application. The association is by links through ole objects as opposed to
these documents being embedded in ole objects. I have been experimenting
with recommendations all based on the document
http://support.microsoft.com/default.aspx?scid=kb;en-us;199066. Despite the
fact that the majority of these documents are linked to, rather than embedded
in, the ole object, the paths I am getting are as follows:
Examining first occurrence of path in ole object only:
DOC_PATH CountOfDOC_PATH
29
C:\Documents and Settings\All Users\Documents\My Pictures\Sample
Pictures\sunset.jpg
1
C:\Documents and Settings\SJLevine\My Documents\NEJMp058062v1.pdf 1
C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0050048383C9}
\PEicons.exe
1
C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0050048383C9}
\wordicon.exe
4
I:\Test fax-QA\registration information.tif
1
When I examine all occurrences of the path in the ole object, I get the
following results:
seqno DOC_PATH
Count
1
21
1 <<Ole Object null>>
8
1 C:\Documents and Settings\All Users\Documents\My
Pictures\Sample Pictures\sunset.jpg
1
1 C:\Documents and Settings\SJLevine\My
Documents\NEJMp058062v1.pdf
1
1 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
1 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
1 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\wordicon.exe
4
1 I:\Test fax-QA\registration information.tif
1
2
20
2 C:\
1
2 C:\Documents and Settings\SJLevine\My
Documents\NEJMp058062v1.pdf
1
2 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
2 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
2 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\wordicon.exe
4
2 I:\Test fax-QA\registration information.tif
1
3
3
3 C:\Documents and Settings\All Users\Documents\My
Pictures\Sample Pictures\sunset.jpg
1
3 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 4
4
2
4 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 2
5
1
5 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
5 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
6
1
6 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
7 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
7 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
Thus it would appear that most of the links are more than once and none of
those links, except in a handful of cases, are the actual link to the
document.
Any help would be appreciated in that creating the links for >500 documents
manually would be tedious and there would be a not unsubstantial risk of
error in associating the document with its record. We might even consider
purchasing an application that does this.
My code for both reports follows:
Option Compare Database
Option Explicit
Private Declare Function GetLongPathName _
Lib "kernel32" _
Alias "GetLongPathNameA" _
(ByVal lpszShortPath As String, _
ByVal lpszLongPath As String, _
ByVal cchBuffer As Long) As Long
Public Sub GetPathFromOleObj1()
Dim dbCurrent As Database, rs As Recordset, rs2 As Recordset, strDocPath As
String
Dim strSQL As String, strDocInfo As String
Set dbCurrent = CurrentDb
Set rs = dbCurrent.OpenRecordset("event_documents", dbOpenDynaset)
Set rs2 = dbCurrent.OpenRecordset("ExaminingFirstPathOnly", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
strDocPath = Nz(Get1stLinkedPath(rs!Edocument), "")
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!DOC_PATH = strDocPath
UpdateRec rs2
rs.MoveNext
Loop
End Sub
Private Sub UpdateRec(rst As Recordset)
On Error GoTo ErrUpdateRec
rst.Update
ExitUpdateRec:
Exit Sub
ErrUpdateRec:
Debug.Print Err.Number & " -- " & Err.Description & " involving " &
rst.Fields(0).Value
Resume ExitUpdateRec
End Sub
Function Get1stLinkedPath(objOLE As Variant) As Variant
Dim strChunk As String, strchunka As String
Dim pathStart As Long
Dim pathEnd As Long
Dim path As String, lngInstrResult As Long
If Not IsNull(objOLE) Then
'Convert string to Unicode.
strchunka = StrConv(objOLE, vbUnicode)
strChunk = strchunka
lngInstrResult = 1
pathStart = 0
'Looks for last occurrence of a valid path so that is not picking up
program with
' which to open file.
'Do While lngInstrResult > 0
lngInstrResult = InStr(lngInstrResult + 2, strChunk, ":\", 1) - 1
'If mapped drive path is not found, try UNC path.
If lngInstrResult <= 0 Then
lngInstrResult = InStr(lngInstrResult + 2, strChunk, "\\", 1)
End If
If lngInstrResult < pathStart Then lngInstrResult = 0
If lngInstrResult > 0 Then
pathStart = lngInstrResult
End If
'Loop
'If either drive letter path or UNC path is found, determine
'the length of the path by searching for the first null
'character Chr(0) after the path was found.
If pathStart > 0 Then
pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
If pathEnd > 0 Then
path = Mid(strChunk, pathStart, pathEnd - pathStart)
Else
path = Mid(strChunk, pathStart, Len(strChunk) - pathStart)
End If
Debug.Print path
Get1stLinkedPath = strGetLongName(path)
Exit Function
End If
Else
Get1stLinkedPath = Null
End If
End Function
Sub GetAllLinkedPath()
Dim dbCurrent As Database, rs As Recordset, rs2 As Recordset, strDocPath As
String
Dim strSQL As String, boolSecondPass As Boolean
Dim strChunk As String, strchunka As String
Dim pathStart As Long, intCounter As Integer
Dim pathEnd As Long
Dim path As String, lngInstrResult As Long
Set dbCurrent = CurrentDb
Set rs = dbCurrent.OpenRecordset("event_documents", dbOpenDynaset)
Set rs2 = dbCurrent.OpenRecordset("ExaminingAllPaths", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
intCounter = 0
boolSecondPass = False
If IsNull(rs!Edocument) Then
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!ole_seqno = 1
rs2!DOC_PATH = "<<Ole Object null>>"
UpdateRec rs2
Else
'Convert string to Unicode.
strChunk = StrConv(rs!Edocument, vbUnicode)
lngInstrResult = 1
pathStart = 0
'Looks for all occurrences of valid paths
Do While lngInstrResult > 0 And Not boolSecondPass
intCounter = intCounter + 1
lngInstrResult = InStr(lngInstrResult + 2, strChunk, ":\",
1) - 1
'If mapped drive path is not found, try UNC path.
If lngInstrResult <= 0 Then
lngInstrResult = InStr(lngInstrResult + 2, strChunk,
"\\", 1)
End If
If lngInstrResult < pathStart Then
lngInstrResult = 0
boolSecondPass = True
End If
pathStart = lngInstrResult
'If either drive letter path or UNC path is found, determine
'the length of the path by searching for the first null
'character Chr(0) after the path was found. If none found,
length of path
'is from pathStart location to end of strChunk.
If pathStart > 0 Or intCounter <= 1 Then
If pathStart > 0 Then
pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
If pathEnd > 0 Then
path = Mid(strChunk, pathStart, pathEnd -
pathStart)
Else
path = Mid(strChunk, pathStart, Len(strChunk) -
pathStart)
End If
Else
path = "<<PathNotFound>>"
End If
Debug.Print path
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!ole_seqno = intCounter
rs2!DOC_PATH = strGetLongName(path)
UpdateRec rs2
End If
Loop
End If
rs.MoveNext
Loop
End Sub
Function strGetLongName(strShortPath As String) As String
Dim strBuffer As String * 1000
If GetLongPathName(strShortPath, strBuffer, Len(strBuffer)) Then
strGetLongName = Left$(strBuffer, InStr(strBuffer, Chr$(0)))
End If
End Function
sjl
application. The association is by links through ole objects as opposed to
these documents being embedded in ole objects. I have been experimenting
with recommendations all based on the document
http://support.microsoft.com/default.aspx?scid=kb;en-us;199066. Despite the
fact that the majority of these documents are linked to, rather than embedded
in, the ole object, the paths I am getting are as follows:
Examining first occurrence of path in ole object only:
DOC_PATH CountOfDOC_PATH
29
C:\Documents and Settings\All Users\Documents\My Pictures\Sample
Pictures\sunset.jpg
1
C:\Documents and Settings\SJLevine\My Documents\NEJMp058062v1.pdf 1
C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0050048383C9}
\PEicons.exe
1
C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-0050048383C9}
\wordicon.exe
4
I:\Test fax-QA\registration information.tif
1
When I examine all occurrences of the path in the ole object, I get the
following results:
seqno DOC_PATH
Count
1
21
1 <<Ole Object null>>
8
1 C:\Documents and Settings\All Users\Documents\My
Pictures\Sample Pictures\sunset.jpg
1
1 C:\Documents and Settings\SJLevine\My
Documents\NEJMp058062v1.pdf
1
1 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
1 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
1 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\wordicon.exe
4
1 I:\Test fax-QA\registration information.tif
1
2
20
2 C:\
1
2 C:\Documents and Settings\SJLevine\My
Documents\NEJMp058062v1.pdf
1
2 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 526
2 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
2 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\wordicon.exe
4
2 I:\Test fax-QA\registration information.tif
1
3
3
3 C:\Documents and Settings\All Users\Documents\My
Pictures\Sample Pictures\sunset.jpg
1
3 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 4
4
2
4 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 2
5
1
5 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
5 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
6
1
6 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
7 C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe 1
7 C:\WINDOWS\Installer\{90110409-6000-11D3-8CFE-
0050048383C9}\PEicons.exe
1
Thus it would appear that most of the links are more than once and none of
those links, except in a handful of cases, are the actual link to the
document.
Any help would be appreciated in that creating the links for >500 documents
manually would be tedious and there would be a not unsubstantial risk of
error in associating the document with its record. We might even consider
purchasing an application that does this.
My code for both reports follows:
Option Compare Database
Option Explicit
Private Declare Function GetLongPathName _
Lib "kernel32" _
Alias "GetLongPathNameA" _
(ByVal lpszShortPath As String, _
ByVal lpszLongPath As String, _
ByVal cchBuffer As Long) As Long
Public Sub GetPathFromOleObj1()
Dim dbCurrent As Database, rs As Recordset, rs2 As Recordset, strDocPath As
String
Dim strSQL As String, strDocInfo As String
Set dbCurrent = CurrentDb
Set rs = dbCurrent.OpenRecordset("event_documents", dbOpenDynaset)
Set rs2 = dbCurrent.OpenRecordset("ExaminingFirstPathOnly", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
strDocPath = Nz(Get1stLinkedPath(rs!Edocument), "")
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!DOC_PATH = strDocPath
UpdateRec rs2
rs.MoveNext
Loop
End Sub
Private Sub UpdateRec(rst As Recordset)
On Error GoTo ErrUpdateRec
rst.Update
ExitUpdateRec:
Exit Sub
ErrUpdateRec:
Debug.Print Err.Number & " -- " & Err.Description & " involving " &
rst.Fields(0).Value
Resume ExitUpdateRec
End Sub
Function Get1stLinkedPath(objOLE As Variant) As Variant
Dim strChunk As String, strchunka As String
Dim pathStart As Long
Dim pathEnd As Long
Dim path As String, lngInstrResult As Long
If Not IsNull(objOLE) Then
'Convert string to Unicode.
strchunka = StrConv(objOLE, vbUnicode)
strChunk = strchunka
lngInstrResult = 1
pathStart = 0
'Looks for last occurrence of a valid path so that is not picking up
program with
' which to open file.
'Do While lngInstrResult > 0
lngInstrResult = InStr(lngInstrResult + 2, strChunk, ":\", 1) - 1
'If mapped drive path is not found, try UNC path.
If lngInstrResult <= 0 Then
lngInstrResult = InStr(lngInstrResult + 2, strChunk, "\\", 1)
End If
If lngInstrResult < pathStart Then lngInstrResult = 0
If lngInstrResult > 0 Then
pathStart = lngInstrResult
End If
'Loop
'If either drive letter path or UNC path is found, determine
'the length of the path by searching for the first null
'character Chr(0) after the path was found.
If pathStart > 0 Then
pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
If pathEnd > 0 Then
path = Mid(strChunk, pathStart, pathEnd - pathStart)
Else
path = Mid(strChunk, pathStart, Len(strChunk) - pathStart)
End If
Debug.Print path
Get1stLinkedPath = strGetLongName(path)
Exit Function
End If
Else
Get1stLinkedPath = Null
End If
End Function
Sub GetAllLinkedPath()
Dim dbCurrent As Database, rs As Recordset, rs2 As Recordset, strDocPath As
String
Dim strSQL As String, boolSecondPass As Boolean
Dim strChunk As String, strchunka As String
Dim pathStart As Long, intCounter As Integer
Dim pathEnd As Long
Dim path As String, lngInstrResult As Long
Set dbCurrent = CurrentDb
Set rs = dbCurrent.OpenRecordset("event_documents", dbOpenDynaset)
Set rs2 = dbCurrent.OpenRecordset("ExaminingAllPaths", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
intCounter = 0
boolSecondPass = False
If IsNull(rs!Edocument) Then
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!ole_seqno = 1
rs2!DOC_PATH = "<<Ole Object null>>"
UpdateRec rs2
Else
'Convert string to Unicode.
strChunk = StrConv(rs!Edocument, vbUnicode)
lngInstrResult = 1
pathStart = 0
'Looks for all occurrences of valid paths
Do While lngInstrResult > 0 And Not boolSecondPass
intCounter = intCounter + 1
lngInstrResult = InStr(lngInstrResult + 2, strChunk, ":\",
1) - 1
'If mapped drive path is not found, try UNC path.
If lngInstrResult <= 0 Then
lngInstrResult = InStr(lngInstrResult + 2, strChunk,
"\\", 1)
End If
If lngInstrResult < pathStart Then
lngInstrResult = 0
boolSecondPass = True
End If
pathStart = lngInstrResult
'If either drive letter path or UNC path is found, determine
'the length of the path by searching for the first null
'character Chr(0) after the path was found. If none found,
length of path
'is from pathStart location to end of strChunk.
If pathStart > 0 Or intCounter <= 1 Then
If pathStart > 0 Then
pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
If pathEnd > 0 Then
path = Mid(strChunk, pathStart, pathEnd -
pathStart)
Else
path = Mid(strChunk, pathStart, Len(strChunk) -
pathStart)
End If
Else
path = "<<PathNotFound>>"
End If
Debug.Print path
rs2.AddNew
rs2!Etracking = rs!Etracking
rs2!Edoc_seqno = rs!Edoc_seqno
rs2!ole_seqno = intCounter
rs2!DOC_PATH = strGetLongName(path)
UpdateRec rs2
End If
Loop
End If
rs.MoveNext
Loop
End Sub
Function strGetLongName(strShortPath As String) As String
Dim strBuffer As String * 1000
If GetLongPathName(strShortPath, strBuffer, Len(strBuffer)) Then
strGetLongName = Left$(strBuffer, InStr(strBuffer, Chr$(0)))
End If
End Function
sjl