Avatar billede tupolev Nybegynder
16. april 2010 - 12:30 Der er 1 løsning

Opdater access database fra Excel

Hej har fundet en kode på nettet som jeg prøver at arbejde med, men den kommer med en fejl.

Jeg har et excel ark Telefontider.xls og en database der heddder Tider2.mdb

Det er syntaks fejl på linien
.FindFirst "Field1='" & MyLookupValue & "'"

Koden ser således ud
Hvad kan jeg gøre?

'=============================================================================
'- UPDATE AN ACCESS RECORD FROM EXCEL
'- FIND SPECIFIED RECORD IN AN ACCESS TABLE FROM EXCEL
'=============================================================================
'- EXCEL  : GETS LOOKUP VALUE FROM ROW CONTAINING SELECTED CELL COLUMN A
'- ACCESS : CHECKS CORRECT RECORD FOUND
'- ACCESS : REPLACES RECORD VALUES WITH EXCEL WORKSHEET VALUES
'- We save code by "changing" field values even if they are the same.
'- Brian Baulsom November 2008
'=============================================================================
Dim ws As Worksheet
Dim FromRow As Long
Dim FromCol As Integer
Dim MyColumnCount As Integer
Dim MyPath As String
Dim db As Database
Dim MyTable As Recordset
Dim MyLookupValue As String
Dim MyMsg As String
Dim MsgLine1 As String
Dim strCriteria As String
Dim rsp
'=============================================================================
'- MAIN ROUTINE
'=============================================================================
Sub UPDATE_RECORD()
    '-------------------------------------------------------------------------
    '- ASSUMES ACCESS .MDB IS IN THE SAME FOLDER AS THIS WORKBOOK
    MyPath = ThisWorkbook.Path & "\"
    ChDrive MyPath
    ChDir MyPath
    '-------------------------------------------------------------------------
    '- EXCEL : GET LOOKUP VALUE & NUMBER OF COLUMNS
    Set ws = ActiveSheet
    With ws
        FromRow = ActiveCell.Row
        MyColumnCount = .Cells(FromRow, .Columns.Count).End(xlToLeft).Column
        MyLookupValue = .Cells(FromRow, "A").Value
    End With
    '-------------------------------------------------------------------------
    '- ACCESS : SET RECORDSET = TABLE
    Set db = DBEngine(0).OpenDatabase(MyPath & "tider2.mdb")
    Set MyTable = db.OpenRecordset("Tabel", dbOpenDynaset)
    With MyTable
        '---------------------------------------------------------------------
        '- DO LOOKUP. HERE USES FIELD CALLED "Field1"
  .FindFirst "Field1='" & MyLookupValue & "'"
        '---------------------------------------------------------------------
        '- CHECK IF MATCH FOUND
        If .NoMatch Then
            MsgBox (MyLookupValue & " not found.")
            GoTo GetOut
        Else
            '------------------------------------------------------------------
            '- MESSAGE TO CHECK CURRENT RECORD
            MsgLine1 = "FOUND RECORD CONTENTS BELOW.    OK to change ?"
            GetMessage          ' SUBROUTINE
          rsp = MsgBox(MyMsg, vbOKCancel, "  FOUND RECORD")
          If rsp = vbCancel Then GoTo GetOut
            '------------------------------------------------------------------
            '- UPDATE ACCESS RECORD
            .Edit
            For FromCol = 1 To MyColumnCount
                .Fields(FromCol - 1).Value = ws.Cells(FromRow, FromCol).Value
            Next
            .Update
            '------------------------------------------------------------------
        End If
    End With
    '--------------------------------------------------------------------------
    '- CONFIRMATION MESSAGE
    MsgLine1 = "CONFIRM CHANGE"
    GetMessage          ' SUBROUTINE
    rsp = MsgBox(MyMsg, vbOKOnly, " CURRENT POSITION")
    '--------------------------------------------------------------------------
GetOut:
    MyTable.Close
    db.Close
    Set MyTable = Nothing
    Set db = Nothing
End Sub
'=============================================================================
'- SUBROUTINE TO SET UP MESSAGE
'- aligns XL values using spaces (not an exact science)
'=============================================================================
Private Sub GetMessage()
    Dim XLval As Variant
    Dim ACval As Variant
    Dim XLalignment As Integer  ' MESSAGE ALIGN XL COLUMN WITH SPACES
    XLalignment = 30
    '-------------------------------------------------------------------------
    With MyTable
        MyMsg = MsgLine1 & vbCr & vbCr _
        & "ACCESSS" & Space(XLalignment) & "EXCEL" & vbCr & vbCr
        '---------------------------------------------------------------------
        '-  CHECK COLUMNS
        For FromCol = 1 To MyColumnCount
            XLval = ws.Cells(FromRow, FromCol)
            ACval = .Fields(FromCol - 1).Value
            MyMsg = MyMsg _
                & .Fields(FromCol - 1).Name & " : " & ACval _
                & Space(XLalignment - Len(CStr(ACval))) _
                & IIf(XLval = ACval, "      =  ", "---->> *") & XLval & vbCr
        Next
    End With
End Sub
'-----------------------------------------------------------------------------
Avatar billede tupolev Nybegynder
01. november 2012 - 07:42 #1
x
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester