I already tried 2 ways:
1. to close the recordset and set the object to nothing
2. close the table using the command: DoCmd.Close acTable, "TF_Classification", acSaveYes
but none works, so any idea?
Thank you.
Expand|Select|Wrap|Line Numbers
- Private Sub Command12_Click()
- Dim xlApp As Object
- Dim xlwkb As Object
- Dim xlsheet As Object
- Dim Conn As ADODB.Connection
- Dim rs As New ADODB.Recordset
- Dim dbWM As Object
- Dim tblWM As Object
- Dim fldWM As Object
- Dim CreateField As Boolean
- If Combo38.Value = vbNullString Then
- RetValue = MsgBox("You have to enter your initial in the Updater field", vbOKOnly)
- Else
- Set xlApp = CreateObject("excel.application")
- Set xlwkb = xlApp.Workbooks.Open(CurrentProject.Path & "\WM_Feedback.xls")
- Set xlsheet = xlwkb.Sheets(1)
- i = 2
- DoCmd.Hourglass True
- DoCmd.SetWarnings False
- CapDis$ = vbNullString
- Set Conn = CurrentProject.Connection
- Do Until xlsheet.Range("A" & i).Formula = vbNullString
- strSQL$ = "SELECT * FROM TF_Classification " & _
- "WHERE (TF_Classification.ISIN = '" & xlsheet.Range("A" & i).Value & "') AND (TF_Classification.Flag_Current = " & True & ");"
- Set rs = New ADODB.Recordset
- rs.Open strSQL$, Conn, adOpenKeyset, adLockOptimistic
- If rs.RecordCount > 0 Then
- strSQL$ = "UPDATE TF_Classification SET TF_Classification.Flag_Current = False " & _
- "WHERE (((TF_Classification.Flag_Current)=True) And ((TF_Classification.ISIN)= '" & xlsheet.Range("A" & i).Value & "'));"
- DoCmd.RunSQL strSQL$
- Else
- End If
- rs.Close
- Set rs = Nothing
- j = 0
- Do Until xlsheet.Range(Chr(66 + j) & "1").Formula = vbNullString
- CreateField = False
- strSQL$ = "SELECT Classification_Fields.* " & _
- "FROM Classification_Fields " & _
- "WHERE (((Classification_Fields.Field_Type)='" & xlsheet.Range(Chr(66 + j) & "1").Formula & "'));"
- Set rs = New ADODB.Recordset
- rs.Open strSQL$, Conn, adOpenKeyset, adLockOptimistic
- If rs.RecordCount = 0 Then
- CreateField = True
- Else
- End If
- 'DoCmd.Close acTable, "TF_Classification", acSaveYes
- If CreateField And xlsheet.Range(Chr(66 + j) & "1").Formula <> "WKN" And xlsheet.Range(Chr(66 + j) & "1").Formula <> "GD260" And xlsheet.Range(Chr(66 + j) & "1").Formula <> "GD270A" And xlsheet.Range(Chr(66 + j) & "1").Formula <> "GD270B" And xlsheet.Range(Chr(66 + j) & "1").Formula <> "GD332" Then
- Set dbWM = CurrentDb
- Set tblWM = dbWM.TableDefs!TF_Classification
- Set fldWM = tblWM.CreateField(xlsheet.Range(Chr(66 + j) & "1").Formula, dbText, 50)
- tblWM.Fields.Append fldWM
- Rem dbWM.TableDefs.Append tblWM
- Else
- End If