Code VBA pour mettre à jour / créer un nouveau dossier à partir d'Excel vers Access

J'ai essayé de regarder partout pour une réponse, mais mes faibles compétences en VBA est vraiment pas m'aider à comprendre ce que j'essaie de code.

J'ai ce code pour l'instant:

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=\\GSS_Model_2.4.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Forecast_T", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
For i = 4 To 16
    x = 0
    Do While Len(Range("E" & i).Offset(0, x).Formula) > 0
' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            .Fields("Products") = Range("C" & i).Value
            .Fields("Mapping") = Range("A1").Value
            .Fields("Region") = Range("B2").Value
            .Fields("ARPU") = Range("D" & i).Value
            .Fields("Quarter_F") = Range("E3").Offset(0, x).Value
            .Fields("Year_F") = Range("E2").Offset(0, x).Value
            .Fields("Units_F") = Range("E" & i).Offset(0, x).Value
            .Update
         ' stores the new record
    End With
    x = x + 1
    Loop
Next i
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Ce code fait exactement ce que je veux jusqu'à présent. Je sais que souhaitez ajouter un morceau qui va vérifier si l'enregistrement existe pas basé sur 4 règles: les Produits, de la Région, Quarter_F et Year_F
Si elle correspond à ces, il devra mettre à jour les autres champs Units_F, PMU). Si non, il doit exécuter le code correctement et créer un nouvel enregistrement.

Votre aide sera très appréciée, je suis coincé ici et je ne vois pas comment en sortir.

Merci

OriginalL'auteur user2225351 | 2013-03-29

  1. 7

    J'ai une feuille de calcul Excel avec les données suivantes à partir de la cellule A1

    product  variety  price
bacon    regular  3.79
bacon    premium  4.89
bacon    deluxe   5.99

    J'ai une Table nommée "Liste de prix" dans ma base de données Access qui contient les données suivantes

    product  variety  price
-------  -------  -----
bacon    premium  4.99
bacon    regular  3.99

    Suivantes Excel VBA sera mise à jour de l'Accès des documents, avec le nouveau prix pour "standard" et "premium", et d'ajouter une nouvelle ligne dans la table pour "deluxe":

    Public Sub UpdatePriceList()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sProduct As String, sVariety As String, cPrice As Variant
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\Gord\Desktop\Database1.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Range("A2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
    sProduct = ActiveCell.Value
    sVariety = ActiveCell.Offset(0, 1).Value
    cPrice = ActiveCell.Offset(0, 2).Value

    rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'"
    If rs.EOF Then
        Debug.Print "No existing record - adding new..."
        rs.Filter = ""
        rs.AddNew
        rs("product").Value = sProduct
        rs("variety").Value = sVariety
    Else
        Debug.Print "Existing record found..."
    End If
    rs("price").Value = cPrice
    rs.Update
    Debug.Print "...record update complete."

    ActiveCell.Offset(1, 0).Activate  ' next cell down
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

    OriginalL'auteur Gord Thompson

  2. 0

    Après avoir écrit cela, je viens de réaliser que vous êtes à l'aide de VBA donc, ma réponse ne fonctionne pas. Mais vous devriez être capable de suivre ce qui se passe. Voici l'idée, bien que. Et pour VBA collections ont un coup d'oeil à ceci:

    VBA Collections 

        // First build your list
    Dim myRecords As New Collection

    For i = 4 To 16
    x = 0
    Do While Len(Range("E" & i).Offset(0, x).Formula) > 0

                var list = from t in myRecords
                           where t.Products == Range("C" & i).Value
                           && t.Region == Range("B2").Value
                           && t.Quarter == Range("E3").Offset(0, x).Value
                           && t.Year == Range("E2").Offset(0, x).Value
                           select t;

                var record = list.FirstOrDefault();

                if (record == null)
                {
                    // a record with your key doesnt exist yet.  this is a new record so add a new one to the list
                    record = new CustomObject();
                    record.Products = Range("C" & i).Value;
                    //  etc.  fill in the rest

                    myRecords.Add(record);
                }
                else
                {
                    // we found this record base on your key, so let's update
                    record.Units += Range("E" & i).Offset(0, x).Value;                
                }

    x = x + 1
    Loop
Next i

                // Now loop through your custom object list and insert into database
    Je vous remercie pour votre réponse, je comprends comment tu fais, mais je suis vraiment en manque les commandes qui doivent être utilisés pour effectuer cela en VBA... Si quelqu'un sait, je serai heureux de vous entendre aussi.
    La dernière fois que j'ai vérifié LINQ n'a pas pu être utilisé en VBA

    OriginalL'auteur Papa Burgundy

  3. 0

    Je n'ai pas assez de réputation pour juste un commentaire sur l'une des réponses ci-dessus. La solution a été excellent, mais si vous avez une tonne de dossiers dans une ligne en boucle, il peut être plus facile pour enfermer le tout dans une boucle. J'ai aussi eu mes données dans un Tableau Excel (mais si vous avez juste un non-gamme dynamique de l'utiliser comme une gamme à la place).

    Set LO = wb.Worksheets("Sheet").ListObjects("YOUR TABLE NAME")
rg = LO.DataBodyRange
'All of the connection stuff from above that is excellent
For x = LBound(rg) To UBound(rg)

'Note that first I needed to find the row in my table containing the record to update
'And that I also got my user to enter all of the record info from a user form
'This will mostly work for you regardless, just get rid of the L/Ubound and search
'Your range for the row you will be working on

    If rg(x,1) = Me.cmbProject.Value Then
        working_row = x
        Exit For
    End If
Next
For i = 2 To 17 ' This would be specific to however long your table is, or another range
'argument would work just as well, I was a bit lazy here
    col_names(i-1) = LO.HeaderRowRange(i) 'Write the headers from table into an array
    Data(i-1) = Me.Controls("Textbox" & i).Value 'Get the data the user entered
Next i
'Filter the Access table to the row you will be entering the data for. I didn't need
'Error checking because users had to select a value from a combobox
rst.Filter = "[Column Name] ='" & "Value to filter on (for me the combobox val)"
For i = 1 To 16 'Again using a len(Data) would work vs. 16 hard code
    rst(col_names(i)).Value = Data(i)
Next i

    C'est ça - puis j'ai fermé la base de données/etc connexions. et a Donné mon utilisateur un message disant que les données avaient été écrits.

    La SEULE chose que vous avez vraiment besoin de noter ici, c'est mon userform n'a pas (encore) intégré des données de vérification de type, mais qui est mon prochain morceau de code. Sinon, vous pouvez obtenir des exceptions de l'Accès ou de certains vraiment mauvais à la recherche de données lorsque vous l'ouvrez!

    OriginalL'auteur Nicholas Smith