Hi Scott,
a couple of macros in word, they will word in access, the trick here is the
document is named the primary key value, of the document table, by the way
the doc_embed field is an image field in the table, should give you an idea
of how it works though. Hopefully you understand the connection open, using
a udl file instead of a connection string.
Sub Insert_Into_SQL()
On Error GoTo Err_Insert_Into_SQL
Dim adoConn As New ADODB.Connection
Dim adoDocument As New ADODB.Recordset
adoConn.Open "File Name=c:\to.udl"
Dim mStream As ADODB.Stream
Dim sql As String
Dim myDoc As String
Dim myDoc2 As String
Dim intLength As Integer
intLength = 0
myDoc = ActiveDocument.FullName
myDoc2 = Strip_Path(myDoc)
If InStr(1, myDoc2, ".doc", vbTextCompare) > 0 Then
myDoc2 = Left(myDoc2, Len(myDoc2) - 4)
End If
ActiveDocument.Close (True)
sql = "Select * from TblCandidate_Contact_History Where
Candidate_Contact_History_ID=" & myDoc2
Set adoDocument = New ADODB.Recordset
adoDocument.Open sql, adoConn, adOpenKeyset, adLockOptimistic
Set mStream = New ADODB.Stream
With mStream
.Type = adTypeBinary
.Open
.LoadFromFile myDoc
End With
With adoDocument
.MoveFirst
.Fields("Doc_Embed").Value = mStream.Read
.Update
.Close
End With
mStream.Close
adoConn.Close
MsgBox "File written into database!"
Application.Quit (False)
Exit_Insert_Into_SQL:
Exit Sub
Err_Insert_Into_SQL:
If Err.Number = -2147217900 Then
MsgBox "This document was not created via the document management
system!", vbCritical + vbOKOnly, "Error!"
GoTo Exit_Insert_Into_SQL
ElseIf Err.Number = 4248 Then
MsgBox "There are no open documents!", vbCritical + vbOKOnly,
"Error!"
GoTo Exit_Insert_Into_SQL
Else
MsgBox "MyMacro" & vbCrLf & "Insert_Into_SQL" & vbCrLf &
Err.Description & vbCrLf & Err.Number & vbCrLf & Erl
Resume Next
End If
End Sub
Function Strip_Path(strFileName As String) As String
On Error GoTo Err_Strip_Path
Dim strFile As String
Dim intPos As Long
Dim strWhatsLeft As String
strWhatsLeft = strFileName
Do While True
If InStr(1, strWhatsLeft, "\") > 0 Then
strWhatsLeft = Right(strWhatsLeft, Len(strWhatsLeft) - InStr(1,
strWhatsLeft, "\"))
Else
Exit Do
End If
Loop
Strip_Path = strWhatsLeft
Exit_Strip_Path:
Exit Function
Err_Strip_Path:
MsgBox Err.Description & vbCrLf & Erl() & vbCrLf & Str(Err.Number),
vbCritical, "Strip_Path"
Resume Next
End Function
Any problems, post back.....