Option Compare Database

Option Explicit

Function getDCSLine(ByVal xStr As String) As String
  While InStr(xStr, " 11 ") <> 0: xStr = Replace(xStr, " 11 ", " 1  1 "): Wend
  While InStr(xStr, " I ") <> 0: xStr = Replace(xStr, " I ", " 1 "): Wend
  While InStr(xStr, " r- ") <> 0: xStr = Replace(xStr, " r- ", " 1 "): Wend
  While InStr(xStr, " r"" ") <> 0: xStr = Replace(xStr, " r"" ", " 1 "): Wend
  While InStr(xStr, " '") <> 0: xStr = Replace(xStr, " '", " 1 "): Wend
  While InStr(xStr, "    ") <> 0: xStr = Replace(xStr, "    ", "   "): Wend
  While InStr(xStr, " 1 ") <> 0: xStr = Replace(xStr, " 1 ", ";;;"): Wend
  While InStr(xStr, " l ") <> 0: xStr = Replace(xStr, " l ", ";;;"): Wend ' soit le chiffre soit la lettre L minuscule
  While InStr(xStr, "   ") <> 0: xStr = Replace(xStr, "   ", ";;;"): Wend
  getDCSLine = xStr
End Function

Function getDCSValue(ByVal xStr As String) As Double
  If InStr(xStr, "  ") Then xStr = Trim(Mid(xStr, InStr(xStr, "  ")))
  If InStr(xStr, "_") Then xStr = Replace(xStr, "_", " ")
  xStr = " " & xStr & " "
  If InStr(xStr, " 1 ") Then xStr = Replace(xStr, " 1 ", "")
  If InStr(xStr, " I ") Then xStr = Replace(xStr, " I ", "")
  If InStr(xStr, " | ") Then xStr = Replace(xStr, " | ", "")
  If InStr(xStr, " ! ") Then xStr = Replace(xStr, " ! ", "")
  
  getDCSValue = MyCDbl(xStr)
End Function

Function getDCSAnomalie(ByVal sAnomalie As String, ByVal xStr As String) As String
  getDCSAnomalie = sAnomalie + IIf(sAnomalie <> "", " - ", "") + xStr
  Stop
End Function
Function DCSAddStr(xStr As String, Optional aMode As Integer = 0)
  DCSAddStr = "'" & Replace(xStr, "'", "''") & "'" & IIf(aMode = 0, ", ", "")
End Function
Public Sub TestDCS()
Dim sRepert As String, sFile As String, xStr As String, StrSQL As String
Dim sTag As String, sImmat As String, sChassis As String, vTypeDoc As Integer, sTypeDocument As String
Dim iv1 As Integer, iv2 As Integer, iv3 As Integer, iv4 As Integer, iv5 As Integer
Dim ii1 As Integer, iip As Integer, xStrInfo As String, xStrLine As String, xStrVal As String, xStrValEnd As String
Dim sMemoClient As String, sCategorie As String
Dim sNumDocExt As String
Dim sClient As String, sAdresse1 As String, sAdresse2 As String, sCP As String, sVille As String
Dim sDossier As String, sNumClient As String, sNumDossier As String, sNumFact As String, sTypeFact As String, sTypeDoc As String, sDateFact As String, smTTC As String
Dim vHT As Double, vTTC As Double, vMtPieces As Double, vMtMainOeuvre As Double, vMtFournitures As Double, vMtDivers1 As Double, vMtDivers2 As Double, vMtPrestations As Double
Dim iiVal As Integer, tStrEntete(20) As String
Dim ii2 As Integer, iig As Integer, iic As Integer
Dim TabStrValue() As String, nbPagePDF As Integer
Dim sKM As String, sDateLivraison As String, sMarque As String, sMemoChassis As String
Dim sDateEntree As String, sConseiller As String, sMemoConseiller As String

Dim sVoid As String, sMemoFirstLine As String, sMsgAnomalie As String, vNewID As Long

sRepert = "c:\projects\bdvo\Docs\ToSend\"
sFile = Dir(sRepert & "*DUPLI*2020_*.pdf")

While sFile <> ""
  FileRead Replace(sRepert & sFile, ".pdf", ".txt"), xStr
  sMsgAnomalie = ""
  TabStrValue = Split(Replace(sFile, ".", "_"), "_")
  ii1 = UBound(TabStrValue): If ii1 > 10 Or ii1 < 9 Then Debug.Print sFile: sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "Format de nom de fichier différent de 9 ou 10 tags")
  smTTC = TabStrValue(ii1 - 1)
  sTypeFact = TabStrValue(1)
  sTypeDoc = TabStrValue(2)
  sCategorie = TabStrValue(2)

  sDateFact = TabStrValue(5) & "/" & TabStrValue(4) & "/" & TabStrValue(3)
  sNumFact = TabStrValue(6)
  sNumClient = TabStrValue(7)
  sNumDocExt = "": vTypeDoc = 0: sTypeDocument = ""
  If sTypeFact = "AVO" Then sNumDocExt = GetItemFromMarks(xStr, "Annulation|dossier|factures|:", vbCRLF)
  If sNumDocExt <> "" Then sTypeFact = "ANN"
  If sTypeFact = "FAC" Then vTypeDoc = 1 Else If sTypeFact = "ANN" Then vTypeDoc = 2 Else If sTypeFact = "AVO" Then vTypeDoc = 3
  If sTypeFact = "FAC" Then sTypeDocument = "FACTURE" Else If sTypeFact = "ANN" Then sTypeDocument = "ANNULATION" Else If sTypeFact = "AVO" Then sTypeDocument = "AVOIR"
  
  nbPagePDF = MyCountStr(xStr, Chr(12))
  
  iic = nbPagePDF: iip = 0
  While iic > 1: iic = iic - 1: iip = InStr(iip + 1, xStr, Chr(12)): Wend
  iic = InStr(iip + 1, xStr, "Total H.T.")
  If iic = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "Tag ""Total H.T."" non trouvé")
  xStrInfo = Mid(xStr, iic)
  vHT = getDCSValue(GetItemFromMarks(xStrInfo, "Total H.T.", vbCRLF))
  vTTC = getDCSValue(GetItemFromMarks(xStrInfo, "Montant TTC", vbCRLF))
  If vTTC = 0 Then vTTC = getDCSValue(GetItemFromMarks(xStrInfo, "Montant TTC", "    "))
  If vTTC = 0 Then vTTC = getDCSValue(GetItemFromMarks(xStrInfo, "net|payer", vbCRLF))
  
  vMtPieces = 0: vMtMainOeuvre = 0: vMtFournitures = 0: vMtDivers1 = 0: vMtDivers2 = 0: vMtPrestations = 0
  xStrInfo = GetItemFromMarks(xStrInfo, "Montant", "")
  xStrInfo = Replace(xStrInfo, ",", "."): sMemoFirstLine = "": iic = 0:   TabStrValue = Split(";;;", ";;;")
  
  While xStrInfo <> ""
    ii1 = InStr(xStrInfo, vbCRLF)
    If ii1 = 0 Then
      xStrInfo = ""
    Else
      iic = iic + 1
      xStrLine = Mid(xStrInfo, 1, ii1 - 1)
      If InStr(xStrLine, "Net ") Then xStrInfo = "": xStrLine = Mid(xStrLine, 1, InStr(xStrLine, "Net ") - 1) & IIf(sMemoFirstLine = "", " ;;; ", "")
      xStrInfo = Mid(xStrInfo, ii1 + 2)
      If sMemoFirstLine <> "" Then
        If InStr(sMemoFirstLine, "---") <> 0 Then sMemoFirstLine = Replace(sMemoFirstLine, "-", " ")
        If Len(sMemoFirstLine) < Len(xStrLine) Then sMemoFirstLine = sMemoFirstLine & String(Len(xStrLine) - Len(sMemoFirstLine) + 1, " ")
          For ii1 = 1 To Len(xStrLine)
            If Mid(xStrLine, ii1, 1) <> " " Then
              If Mid(sMemoFirstLine, ii1, 1) = " " Then
                sMemoFirstLine = Mid(sMemoFirstLine, 1, ii1 - 1) + Mid(xStrLine, ii1, 1) + Mid(sMemoFirstLine, ii1 + 1)
              Else
                'Stop
              End If
            End If
          Next ii1
        xStrLine = sMemoFirstLine
      End If
      If MyCountStr(xStrLine, ".") >= 5 Then TabStrValue = Split(getDCSLine(xStrLine), ";;;") Else If iic > 1 Then sMemoFirstLine = xStrLine

      If UBound(TabStrValue) >= 5 And iic > 0 Then
        If (IsNumeric(TabStrValue(1))) Or (IsNumeric(TabStrValue(2))) Then
          sMemoFirstLine = "": xStrInfo = ""
          vMtPieces = MyCDbl(TabStrValue(1))
          vMtMainOeuvre = MyCDbl(TabStrValue(2))
          vMtFournitures = MyCDbl(TabStrValue(3))
          vMtDivers1 = MyCDbl(TabStrValue(4))
          vMtDivers2 = MyCDbl(TabStrValue(5))
          vMtPrestations = vMtMainOeuvre + vMtFournitures + vMtDivers1 + vMtDivers2
        End If
      End If
    End If
  Wend
  
  If vHT = 0 Then
    vHT = vMtPieces + vMtPrestations
  Else
    If (Format(vHT, "0.00") <> Format(vMtPieces + vMtPrestations, "0.00")) And (vMtPieces + vMtPrestations <> 0) Then
      If (Format(Abs(vHT), "0.00") <> Format(Abs(vMtPieces + vMtPrestations), "0.00")) And (vMtPieces + vMtPrestations <> 0) Then
        sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "Pb valeurs cumulées pour le contrôle du HT")
      End If
    End If
    If (vMtPieces + vMtPrestations <> 0) Then vHT = vMtPieces + vMtPrestations
  End If
  If (Format(Abs(vTTC) * 100, "0") <> smTTC) Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "Différence entre tag TTC du nom de fichier et la valeur trouvée")
  If MyCInt(smTTC) <> 0 Then If vTTC = 0 Or vHT = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "une des valeurs HT ou TTC est à zéro")
  
  
  iv1 = InStr(xStr, "N°Client")
  iv2 = InStr(iv1 + 1, xStr, vbCRLF)
  ii1 = InStr(iv2 + 1, xStr, "FACTURE")
  ii2 = InStr(iv2 + 1, xStr, "AVOIR")
  If ii2 <> 0 And (ii2 < ii1 Or ii1 = 0) Then ii1 = ii2
  ii2 = InStr(iv2 + 1, xStr, "DEMANDE"): iig = InStr(ii2 + 1, xStr, "GARANTIE"): If iig > ii2 + 15 Then ii2 = 0
  If ii2 <> 0 And (ii2 < ii1 Or ii1 = 0) Then ii1 = ii2
  ii2 = InStr(iv2 + 1, xStr, "DUPLICATA")
  If ii2 <> 0 And (ii2 < ii1 Or ii1 = 0) Then ii1 = ii2
  iv2 = ii1
  iv3 = InStr(iv2 + 1, xStr, "Marque")
  iv4 = InStr(iv3 + 1, xStr, "Date d'entrée")
  iv5 = InStr(iv4 + 1, xStr, "Référence")
  
  If iv1 = 0 Or iv2 = 0 Or iv3 = 0 Or iv4 = 0 Or iv5 = 0 Then
      If iv1 = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "le tag correspondant à iv1 n'a pas été trouvé")
      If iv2 = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "le tag correspondant à iv2 n'a pas été trouvé")
      If iv3 = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "le tag correspondant à iv3 n'a pas été trouvé")
      If iv4 = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "le tag correspondant à iv4 n'a pas été trouvé")
      If iv5 = 0 Then sMsgAnomalie = getDCSAnomalie(sMsgAnomalie, "le tag correspondant à iv5 n'a pas été trouvé")
      sImmat = "": sChassis = ""
      sTag = GetTagString(xStr, 9, 1)
      If Len(sTag) = 9 Then sImmat = Replace(sTag, "-", "")
      
      sTag = GetTagString(xStr, 17, 1)
      If Len(sTag) = 17 Then sChassis = sTag
  End If
  
' traitement de l'entête
  xStrInfo = Mid(xStr, 1, iv2 - 1)
  xStrVal = "": xStrValEnd = "": iiVal = 0: sClient = "": sAdresse1 = "": sAdresse2 = ""
  While xStrInfo <> ""
    ii1 = InStr(xStrInfo, vbCRLF)
    If ii1 = 0 Then
      xStrInfo = ""
    Else
      xStrLine = Mid(Mid(xStrInfo, 1, ii1 - 1), 115)
      xStrInfo = Mid(xStrInfo, ii1 + 2)
      If Len(Replace(xStrLine, " ", "")) > 4 Then
        xStrVal = xStrVal & " - " & Trim(xStrLine)
        If Trim(xStrLine) <> "FACTURE ETABLIE POUR LE COMPTE DE" Then iiVal = iiVal + 1: tStrEntete(iiVal) = Trim(xStrLine)
      End If
    End If
  Wend
  If IsNumeric(Mid(tStrEntete(iiVal), 1, 5)) Then sCP = (Mid(tStrEntete(iiVal), 1, 5)): sVille = Trim(Mid(tStrEntete(iiVal), 6)): iiVal = iiVal - 1
  sClient = tStrEntete(1): If iiVal >= 2 Then sAdresse1 = tStrEntete(2)
  If iiVal >= 3 Then sAdresse2 = tStrEntete(3)
  
' traitement de la ligne n°Client-n°Dossier-n°Facture-Page-Date
  xStrInfo = Mid(xStr, iv1, iv2 - iv1)
  sMemoClient = ""
  While xStrInfo <> ""
    ii1 = InStr(xStrInfo, vbCRLF)
    If ii1 = 0 Then
      xStrInfo = ""
    Else
      xStrLine = Mid(Mid(xStrInfo, 1, ii1 - 1), 1, 114)
      xStrInfo = Mid(xStrInfo, ii1 + 2)
      If IsNumeric(Mid(Trim(xStrLine), 1, 6)) Then
        sMemoClient = xStrLine
      Else
        If sMemoClient <> "" And Trim(xStrLine) <> "" Then
          If Len(sMemoClient) < Len(xStrLine) Then sMemoClient = Mid(sMemoClient + String(Len(xStrLine), " "), 1, Len(xStrLine))
          For ii1 = 1 To Len(xStrLine)
            If Mid(xStrLine, ii1, 1) <> " " Then
              If Mid(sMemoClient, ii1, 1) = " " Then
                sMemoClient = Mid(sMemoClient, 1, ii1 - 1) + Mid(xStrLine, ii1, 1) + Mid(sMemoClient, ii1 + 1)
              Else
                'Stop
              End If
            End If
          Next ii1
        End If
      End If
    End If
  Wend
  While InStr(sMemoClient, "  "): sMemoClient = Replace(sMemoClient, "  ", " "): Wend
  sMemoClient = Trim(Replace(sMemoClient, "1/" & Format(nbPagePDF, "0"), ""))
  sMemoClient = Replace(Replace(sMemoClient, " 1 ", ";"), " ' ", ";")
  sDossier = GetItemFromMarks(xStr, " OR ", " du ")
  If sDossier = "" Then sDossier = GetItemFromMarks(xStr, " BL ", " du ")
  sDossier = Replace(sDossier, " ", "")
  
  
' traitement de la ligne Marque-Type de véhicule-N°immatriculation-N°de série-N° Plaque ovale-Date Livraison Véhicule-Km
  xStrInfo = Mid(xStr, iv3, iv4 - iv3)
  sVoid = GetTagString(xStrInfo, 18, 1)
  If sVoid <> "" Then xStrInfo = Replace(xStrInfo, sVoid, "1 " & Mid(sVoid, 2))
  
  xStrInfo = Replace(xStrInfo, "Date Livraison Véhicule", "Date Livraison         ")
  sMemoChassis = "": sMarque = "": sImmat = "": sChassis = "": sDateLivraison = "": sKM = ""
  xStrInfo = getDCSLine(xStrInfo)
  While xStrInfo <> ""
    ii1 = InStr(xStrInfo, vbCRLF)
    If ii1 = 0 Then
      xStrInfo = ""
    Else
      xStrLine = Mid(xStrInfo, 1, ii1 - 1)
      xStrInfo = Mid(xStrInfo, ii1 + 2)
      If MyCountStr(xStrLine, ";;;") = 5 Then If Mid(xStrLine, Len(xStrLine) - 1) = " 1" Then xStrLine = Mid(xStrLine, 1, Len(xStrLine) - 1) & ";;;"
      TabStrValue = Split(xStrLine, ";;;")

      If UBound(TabStrValue) >= 5 Then
        If (IsNumeric(TabStrValue(UBound(TabStrValue)))) Or (IsDate(TabStrValue(UBound(TabStrValue) - 1))) Or (Len(Trim(TabStrValue(UBound(TabStrValue) - 3))) = 17) Then
          sMemoChassis = xStrLine
          If IsNumeric(TabStrValue(UBound(TabStrValue))) Then sKM = Trim(TabStrValue(UBound(TabStrValue)))
          If IsDate(TabStrValue(UBound(TabStrValue) - 1)) Then sDateLivraison = Trim(TabStrValue(UBound(TabStrValue) - 1))
          If Len(Trim(Replace(TabStrValue(UBound(TabStrValue) - 3), " ", ""))) = 17 Then sChassis = Trim(Replace(TabStrValue(UBound(TabStrValue) - 3), " ", ""))
          sImmat = Trim(TabStrValue(UBound(TabStrValue) - 4))
          sMarque = Trim(TabStrValue(0))
          If sChassis = "" Then sChassis = GetTagString(xStrLine, 17, 1)
        End If
      End If
    End If
  Wend
  If sChassis = "" Then sChassis = GetTagString(xStr, 17, 1)
  
  
' traitement de la ligne - Date d'entrée - Type/E - Demandeur - Réceptionnaire - N°V/O - Réf. garantie
  xStrInfo = Mid(xStr, iv4, iv5 - iv4)
  sMemoConseiller = "": sDateEntree = "": sConseiller = "": sMemoFirstLine = "": iic = 0
  While xStrInfo <> ""
    iic = iic + 1
    ii1 = InStr(xStrInfo, vbCRLF)
    If ii1 = 0 Then
      xStrInfo = ""
    Else
      xStrLine = Mid(xStrInfo, 1, ii1 - 1)
      
      If sMemoFirstLine <> "" Then
          For ii1 = 1 To Len(xStrLine)
            If Mid(xStrLine, ii1, 1) <> " " Then
              If Mid(sMemoFirstLine, ii1, 1) = " " Then
                sMemoFirstLine = Mid(sMemoFirstLine, 1, ii1 - 1) + Mid(xStrLine, ii1, 1) + Mid(sMemoFirstLine, ii1 + 1)
              Else
                'Stop
              End If
            End If
          Next ii1
          xStrLine = sMemoFirstLine
      End If
      If Len(Replace(xStrLine, " ", "")) < 10 Then sMemoFirstLine = xStrLine
      xStrLine = getDCSLine(xStrLine)
      xStrInfo = Mid(xStrInfo, ii1 + 2)
'      If MyCountStr(xStrLine, ";;;") = 5 Then If Mid(xStrLine, Len(xStrLine) - 1) = " 1" Then xStrLine = Mid(xStrLine, 1, Len(xStrLine) - 1) & ";;;"
      TabStrValue = Split(xStrLine, ";;;")

      If iic > 1 And UBound(TabStrValue) >= 4 Then
        If (IsDate(TabStrValue(0)) Or Len(Trim(TabStrValue(3)) > 10)) Then
          sMemoChassis = xStrLine
          If IsDate(TabStrValue(0)) Then sDateEntree = Trim(TabStrValue(0))
          If Len(Trim(TabStrValue(3))) > 10 Then sConseiller = Trim(TabStrValue(3))
        End If
      End If
    End If
  Wend
  
  vNewID = MyCLng(MyDLookup("idDoc", "Select max(idDocument) as idDoc from SPL_Docs where idDocument<400000", "")) + 1
  sNumFact = Replace(sNumFact, "VO", "")
  sImmat = Replace(sImmat, "-", "")
  StrSQL = "INSERT INTO SPL_Docs (idDocument, DateImpression, DateUpdated, Site, SitePrint, TypeDMS, sFichier, DateDocument,"
  StrSQL = StrSQL & "TypeDoc, TypeDocument, NDocument, NumDocExt, NumDoc, "
  StrSQL = StrSQL & "sClient, HT, TTC, sImmatriculation, KMS, "
  StrSQL = StrSQL & "sAdresse1, sAdresse2, sCP, sVille, sConseiller, nClient, "
  StrSQL = StrSQL & "sChassis, sMarque, DateEntree, sCategorie, MtPieces, MtPrestations"
  StrSQL = StrSQL & ") SELECT " & Format(vNewID, "0") & ", " & GetSQLDateAndTime(FileDateTime(sRepert & sFile)) & ", now, 'BETHUNE-NI', 'BETHUNE-NI', 3, '" & LCase(sFile) & "'," & GetSQLDate(MyCDate(sDateFact)) & ", "
  StrSQL = StrSQL & Format(vTypeDoc, "0") & ", " & DCSAddStr(sTypeDocument) & DCSAddStr(sNumFact) & DCSAddStr(sNumDocExt) & DCSAddStr(Format(MyCLng(sNumFact), "0"))
  StrSQL = StrSQL & DCSAddStr(sClient) & Format(vHT, "0.00") & ", " & Format(vTTC, "0.00") & ", " & DCSAddStr(sImmat) & Format(MyCLng(sKM), "0") & ", "
  StrSQL = StrSQL & DCSAddStr(sAdresse1) & DCSAddStr(sAdresse2) & DCSAddStr(sCP) & DCSAddStr(sVille) & DCSAddStr(sConseiller) & DCSAddStr(sNumClient)
  StrSQL = StrSQL & DCSAddStr(sChassis) & DCSAddStr(sMarque) & IIf(sDateEntree = "", "Null", GetSQLDate(MyCDate(sDateEntree))) & "," & DCSAddStr(sCategorie) & Format(vMtPieces, "0.00") & ", " & Format(vMtPrestations, "0.00")
  Debug.Print StrSQL
  CurrentDb.Execute StrSQL
  
'  Debug.Print sImmat, sChassis, sDateLivraison, sKM, Mid(sFile & String(30, " "), 1, 70), Replace(Replace(Replace(Replace(sMemoClient, sDossier, ""), sNumClient, ""), sDateFact, ""), sNumFact, ""), xStrVal
  Debug.Print vHT, vTTC, sImmat, sChassis, sDateEntree, sConseiller, Mid(sFile & String(30, " "), 1, 70), Replace(Replace(Replace(Replace(sMemoClient, sDossier, ""), sNumClient, ""), sDateFact, ""), sNumFact, ""), xStrVal
'  Stop
  sFile = Dir
Wend

End Sub