|
Danke erstmal für Deine Antwort:
-
Wovon reden wir hier genau bei "externen Datenaufbereitungsanbieter"? Sagt Dir Synesty was? Die bearbeiten in Flows die Daten so, dass es für unser Waren/Wirtschaftssystem passt.
-
Auf welchem Weg / Wie und Wo wird der EAN Code geprüft und ggf. eingefügt. siehe Code
-
Sind in der Mappe Ereignisse in Benutzung? (diese könnten bei unsachgemäßer Handhabung zu erhöhtem Rechenaufwand führen) ich hoffe im Code ersichtlich
-
Werden Formeln in der Mappe in Verwendung? (sind diese direkt oder indirekt von der EAN abhängig, kann das zu erhöhtem Rechenaufwand führen), nur ganz banale, aber ja: zB. =WENN(C32>0;"#NV";"")
-
Sind bedingte Formatierungen im Einsatz? Ja
-
Über welche Menge an Datensätzen reden wir hier überhaupt (50, 1.000, 15.000, 100.000, 500.000, ...)? Maximal 50 Zeilen
Wir haben sonst 2 Jahre keine Probleme gehabt, es war von heute auf morgen da.
Anbei der Code, Reiter "Felgenankauf"
Sub FixNVFelgenankauf()
Dim wshList As Worksheet
Dim rngNV As Range
Dim bError As Boolean
Set wshList = ThisWorkbook.Worksheets(2)
Do
Set rngNV = wshList.Range("A:A").Find("#NV", LookIn:=xlValues)
If Not rngNV Is Nothing Then
rngNV.Value = getEAN(bError)
If bError Then
MsgBox "Es ist ein Fehler beim auslesen der EAN-Liste aufgetreten", vbCritical
rngNV.Select
Exit Do
End If
End If
Loop While Not rngNV Is Nothing
End Sub
Function getEAN(ByRef bError As Boolean) As String
On Error GoTo Err_Handler
Dim wbk As Workbook
Dim wsh As Worksheet
Dim rngEAN As Range
bError = False
Set wbk = GetWorkbook(ThisWorkbook.Path & "\EAN.xlsx")
Set wsh = wbk.Worksheets(1)
For Each rngEAN In Intersect(wsh.UsedRange, wsh.Range("A:A")).Cells
If IsNumeric(rngEAN.Value) Then
getEAN = rngEAN.Value
rngEAN.ClearContents
wbk.Save
Exit For
End If
Next
wbk.Close
Err_Exit:
Exit Function
Err_Handler:
Err.Clear
bError = True
Resume Err_Exit
End Function
Function GetWorkbook(sFullFilename As String) As Workbook
Dim wbk As Workbook
Dim bFound As Boolean
For Each wbk In Application.Workbooks
If LCase(wbk.FullName) = LCase(sFullFilename) Then
Set GetWorkbook = wbk
bFound = True
Exit For
End If
Next
If Not bFound Then
Set GetWorkbook = Application.Workbooks.Open(sFullFilename)
ThisWorkbook.Activate
End If
End Function
Sub GetItemsFelgenankauf()
Dim postDate As String
Dim strBoundary As String
Dim token As String
strBoundary = "HTTP_POST_BOUNDARY"
postDate = "username=Excel-Rest-API&password=XXX"
Dim strURL As String
strURL = "https://www.XXX.de/rest/login"
Dim hReq As New WinHttpRequest
hReq.Open "POST", strURL, False
hReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
hReq.SetRequestHeader "Accept", "*/*"
hReq.Send postDate
Dim json As Object
Set json = JsonConverter.ParseJson(hReq.responseText)
token = "Bearer " & json("access_token")
Set hReq = Nothing
Dim data As String
Dim externalId As String
Dim ean As String
Dim itemId As String
Dim number As String
Dim vatId As Integer
Dim itemName As String
Dim datastring As String
Dim purchasePrice As Double
Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet
ws.Range("C2").Select
Do Until IsEmpty(ActiveCell)
If IsEmpty(ws.Range("B" & (ActiveCell.Row)).Value) = True Then
ws.Range("D" & (ActiveCell.Row)).Select
externalId = ActiveCell.Value
ws.Range("A" & (ActiveCell.Row)).Select
ean = ActiveCell.Value
ws.Range("E" & (ActiveCell.Row)).Select
purchasePrice = CDec(ActiveCell.Value)
ws.Range("C" & (ActiveCell.Row)).Select
itemName = ActiveCell.Value
ws.Range("G" & (ActiveCell.Row)).Select
number = ws.Name & "\\" & ActiveCell.Value & "\\" & "G" & ActiveCell.Row
If IsEmpty(ws.Range("F" & (ActiveCell.Row)).Value) = False Then
ws.Range("F" & (ActiveCell.Row)).Select
If ActiveCell.Value = 19 = True Then
vatId = 0
ElseIf ActiveCell.Value = 7 Then
vatId = 1
ElseIf ActiveCell.Value = 0 Then
vatId = 2
End If
End If
If IsEmpty(ws.Range("G" & (ActiveCell.Row)).Value) = False Then
ws.Range("G" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("H" & (ActiveCell.Row)).Value) = False Then
ws.Range("H" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("I" & (ActiveCell.Row)).Value) = False Then
ws.Range("I" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("J" & (ActiveCell.Row)).Value) = False Then
ws.Range("J" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("K" & (ActiveCell.Row)).Value) = False Then
ws.Range("K" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
datastring = datastring & " | Bezahlt: "
If IsEmpty(ws.Range("P" & (ActiveCell.Row)).Value) = False Then
ws.Range("P" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("Q" & (ActiveCell.Row)).Value) = False Then
ws.Range("Q" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
If IsEmpty(ws.Range("R" & (ActiveCell.Row)).Value) = False Then
ws.Range("R" & (ActiveCell.Row)).Select
datastring = datastring & ActiveCell.Value & " "
End If
data = "{""texts"":[{""lang"":""de"", ""name1"": """ & itemName & """, ""shortDescription"": """ & datastring & """}],""variations"":[{""externalId"":""" & externalId & """, ""purchasePrice"":" & purchasePrice & ",""number"":""" & number & """, ""isMain"": true, ""vatId"": """ & vatId & """, ""variationBarcodes"":[{ ""code"":""" & ean & """, ""barcodeId"": 1}], ""unit"":{""unitId"": 1,""content"": 1},""variationCategories"":[{""categoryId"": 2230}]}]}"
strURL = "https://www.XXX.de/rest/items"
Dim hPost As New WinHttpRequest
hPost.Open "POST", strURL, False
hPost.SetRequestHeader "Content-Type", "application/json"
hPost.SetRequestHeader "Authorization", token
hPost.Send data
Dim response As Object
Set response = JsonConverter.ParseJson(hPost.responseText)
If response.Exists("error") Then
Set response = response("error")
If response.Exists("code") Then
MsgBox (response("message"))
End If
End If
ws.Range("B" & (ActiveCell.Row)).Select
ActiveCell.Value = response("id")
Set hPost = Nothing
Else
strURL = "https://www.XXX.de/rest/items/" & ws.Range("B" & (ActiveCell.Row)).Value
Dim iGet As New WinHttpRequest
iGet.Open "GET", strURL, False
iGet.SetRequestHeader "Accept", "application/json"
iGet.SetRequestHeader "Content-Type", "application/json"
iGet.SetRequestHeader "Authorization", token
iGet.Send
Dim Value As Dictionary
Set Value = JsonConverter.ParseJson(iGet.responseText)
If Value.Exists("error") Then
Set Value = Value("error")
If Value.Exists("code") Then
MsgBox (Value("message"))
End If
End If
If Value.Exists("mainVariationId") Then
strURL = "https://www.XXX.de/rest/items/" & ws.Range("B" & (ActiveCell.Row)).Value & "/variations/" & Value("mainVariationId") & "/stock"
Dim vGet As New WinHttpRequest
vGet.Open "GET", strURL, False
vGet.SetRequestHeader "Accept", "application/json"
vGet.SetRequestHeader "Content-Type", "application/json"
vGet.SetRequestHeader "Authorization", token
vGet.Send
Dim responseText As String
responseText = vGet.responseText
responseText = "{""data"":" & responseText & "}"
Dim Parsed As Dictionary
Set Parsed = JsonConverter.ParseJson(responseText)
If Parsed.Exists("data") Then
Dim Values As Variant
ReDim Values(Parsed("data").Count, 10)
Dim Stock As Dictionary
Dim i As Long
i = 0
For Each Stock In Parsed("data")
i = i + Stock("netStock")
Next Stock
ws.Range("X" & (ActiveCell.Row)).Select
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = i
End If
If ActiveCell.Value = 0 Then
ActiveCell.Value = i
End If
End If
End If
Set iGet = Nothing
Set vGet = Nothing
End If
ws.Range("C" & (ActiveCell.Row)).Select
ActiveCell.Offset(1, 0).Select
Loop
Set wshshell = CreateObject("WScript.Shell")
wshshell.Run "https://apps.synesty.com/studio/api/flow/v1?id=$2a$10$L2FPcUGhstDoo6Xgz4m8yOT/P4n.hQJItHOe06OBPBspozf8KfIUW"
End Sub
|