RE: How to Increment Column For Each Record thru Module

Tech-Archive recommends: Speed Up your PC by fixing your registry

Sounds like the combo causing the error is a bound control. Combo boxes used
for searching or filtering should be unbound controls.

What is happening is you have changed the value in the control when you
selected a different item in the combo. Since it is part of a primary key,
it has to be a unique value. When you try to move away from the current
record, Access wants to update the current record because a bound field has
changed values, but it can't update the record because there is another
record with the same Account_no and Task_No combination.

You will need to make the combo an unbound field and add a text box to the
form as the bound control.
--
Dave Hargis, Microsoft Access MVP


"Reddy" wrote:

Dave!
It imports one form then gets error message for the next one.
The data type is text and it is set up as primary key on combination of
Account_no and Task_No.

Error Message:
-2147217887:The changes you requested to the table were not successful
because they would create duplicates values in the index, primary key or
relationship. Change the data in the field or fields that contain duplicate
data , remove the index, or redefine the index to permit duplicate entries
and try again.


"Klatuu" wrote:

When you say it works fine for one form then stops, what do you mean? Does
it exit the code or do you get an error? If you get an error, what line is
it on and what is the error number?

Also, I have a question about this line:
![Task No] = Format(Nz(DMax("Val([Task No])", "[Task]"), 0) + 1, "0000")
What is the data type of [Task No]?

--
Dave Hargis, Microsoft Access MVP


"Reddy" wrote:

Thank you Kaltuu, sorry I forgot to mention the TaskNo column. Please my
below code.
The code works fine when there is no index are setup to TaksNo column, when
i make the change and setup a index column on TaskNo column the code stop
after one form is imported. help me out

Sub fImportTaskForm()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
Dim strfile As String
Dim strpath As String

On Error GoTo ErrorHandling

'Find the first text file

strpath = "C:\MyWorks\"
strfile = Dir(strpath & "*.doc")

'Create the Word Object
Set appWord = CreateObject("Word.Application")

'Connect to the data
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\database\" &
"Healthcare Contracts.mdb;"
rst.Open "Task", cnn, adOpenKeyset, adLockOptimistic

'Loop through the string & import the files

Do While Len(strfile) > 0
Set doc = appWord.Documents.Open(strPath & "\" & strfile)
strMyVar = Replace(strfile, ".doc", "_")

With rst
.AddNew
![Account No] = 5075
![Task No] = Format(Nz(DMax("Val([Task No])", "[Task]"), 0) +
1, "0000")
![Alternate Task No] = doc.FormFields("fldTaskNum").Result
![Task Name] = doc.FormFields("fldApplication").Result & " " & _
doc.FormFields("fldCategory").Result & " " & _
doc.FormFields("fldSubcategory").Result
![Task Description] = doc.FormFields("fldTaskDesc").Result
![Point of Contact] = doc.FormFields("fldGContact").Result
![Estimated Hours] = doc.FormFields("fldTotalEstHrs").Result
![BillDate] = doc.FormFields("fldDateApproved").Result
.Update
End With
doc.Close
'Call Dir to get the next file
strfile = Dir
Loop 'END OF LOOP

MsgBox "USDA TASK Form Imported!"

Cleanup:
appWord.Quit
cnn.Close
rst.Close
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub



"Klatuu" wrote:

You specify "TaskNo" in your question, but nowhere in your code can I find
that field. Can you provide some additional details as to where the TaskNo
is and what the rules are for incrementing it?

Also, you can make this run much faster by restructuring the code. You are
creating the Word application object for each document. This takes a lot of
time. Here is a suggestion for speeding it up:

Sub fImportTaskForm()
Dim appWord As Word.Application
Dim doc As Word.Document
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
Dim strfile As String
Dim strpath As String

On Error GoTo ErrorHandling

'Find the first text file

strpath = "C:\MyWorks\"
strfile = Dir(strpath & "*.doc")

'Create the Word Object
Set appWord = CreateObject("Word.Application")

'Connect to the data
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\database\" &
"Healthcare Contracts.mdb;"
rst.Open "Task", cnn, adOpenKeyset, adLockOptimistic

'Loop through the string & import the files

Do While Len(strfile) > 0
Set doc = appWord.Documents.Open(strPath & "\" & strfile)
strMyVar = Replace(strfile, ".doc", "_")

With rst
.AddNew
![Account No] = 5075

![Alternate Task No] = doc.FormFields("fldTaskNum").Result
![Task Name] = doc.FormFields("fldApplication").Result & " " & _
doc.FormFields("fldCategory").Result & " " & _
doc.FormFields("fldSubcategory").Result
![Task Description] = doc.FormFields("fldTaskDesc").Result
![Point of Contact] = doc.FormFields("fldGContact").Result
![Estimated Hours] = doc.FormFields("fldTotalEstHrs").Result
![BillDate] = doc.FormFields("fldDateApproved").Result
.Update
End With
doc.Close
'Call Dir to get the next file
strfile = Dir
Loop 'END OF LOOP

MsgBox "USDA TASK Form Imported!"

Cleanup:
appWord.Quit
cnn.Close
rst.Close
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Exit Sub


I took this out:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

It is never used and Dim fso should be Dim fso As Object. As written, it
creates a Variant type variable named fso.
--
Dave Hargis, Microsoft Access MVP


"Reddy" wrote:

Hello VB Gurus!

My below module works great but I have text column "TaskNo" which needs to
be increment for very word document form that I import. Please help me out.

'Code.............

Sub fImportTaskForm()

Dim appWord As Word.Application
Dim doc As Word.Document
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
Dim strfile As String
Dim strPath As String


Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

On Error GoTo ErrorHandling

'File path '
strPath = "C:\MyWorks\"

'Change the default directory to the file path

ChDir strPath

'Find the firsttext file

strfile = Dir("*.doc")

'Loop through the string & import the files



Do While Len(strfile) > 0


Set appWord = CreateObject("Word.Application")
Set doc = appWord.Documents.Open(strPath & "\" & strfile)

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=C:\database\" &
"Healthcare Contracts.mdb;"
rst.Open "Task", cnn, adOpenKeyset, adLockOptimistic

strMyVar = Replace(strfile, ".doc", "_")


With rst
.AddNew
![Account No] = 5075
![Alternate Task No] = doc.FormFields("fldTaskNum").Result
![Task Name] = doc.FormFields("fldApplication").Result & " " &
doc.FormFields("fldCategory").Result & " " &
doc.FormFields("fldSubcategory").Result
![Task Description] = doc.FormFields("fldTaskDesc").Result
![Point of Contact] = doc.FormFields("fldGContact").Result
![Estimated Hours] = doc.FormFields("fldTotalEstHrs").Result
![BillDate] = doc.FormFields("fldDateApproved").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close

Cleanup:
Set rst = Nothing
Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing


'Call Dir to get the next file
strfile = Dir


Loop 'END OF LOOP

MsgBox "USDA TASK Form Imported!"

Exit Sub

ErrorHandling:
Select Case Err
Case -2147022986, 429
Set appWord = CreateObject("Word.Application")
blnQuitWord = True
Resume Next
Case 5121, 5174
MsgBox "You must select a valid Word document. " _
& "No data imported.", vbOKOnly, _
"Document Not Found"
Case 5941
MsgBox "The document you selected does not " _
& "contain the required form fields. " _
& "No data imported.", vbOKOnly, _
"Fields Not Found"
Case Else
MsgBox Err & ": " & Err.Description
End Select
GoTo Cleanup


End Sub
.

Relevant Pages

  • Re: Looping through Query to create multiple sheets in excel- Just need the loop
    ... I always get to this point and I can't figure out how to loop through ... I have put the string in the query at the bottom. ... Optional strWorkSheet As String, Optional strRange As ... Dim objXLSheet As Object 'Excel.Worksheet ...
    (microsoft.public.access.forms)
  • Re: How is this conditional able to execute?
    ... inside the loop, then each time the loop iterates then a NEW reference to ... Note that the test of returndata is not a type. ... Dim returndata As String = "" ... Not that 'Changing' is only displayed when returndata is NOT an empty string ...
    (microsoft.public.dotnet.languages.vb)
  • Re: How is this conditional able to execute?
    ... Why is this part out of the loop: ... Maybe I just don't understand the returndata = "" because of the byte array. ... How can I read the string in: ... > Dim t As Thread ...
    (microsoft.public.dotnet.languages.vb)
  • Re: How to put lines with certain text (from a file) in an array
    ... In one sense all consistent but now the Filter approach is taking about 2x longer than the loop with Instr with all sizes. ... Dim sFile As String, sText As String ...
    (microsoft.public.excel.programming)
  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)