Dim Mldg As String
Dim Stil As String
Dim Titel As String
Dim Antwort As String
Dim AlterName As String
Dim Neuername As String
Dim Datei As String
Dim Zeile As String
Dim sString As String
Dim Kopf As String
Dim Spliter As Variant
Dim LieferNr As String
Dim Datum As String
Dim Kunde As String
Dim Karton As String
Dim GesMe As String
Dim Gewicht As String
Dim OrderNr As String
Dim Zusatztext As String
Dim EAN As String
Dim Grösse As String
Dim Menge As String
Dim Dir2 As String
Dim Dir3 As String
Dim Drive As String
 
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
 
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
 
Private Sub EXIT_Click()
End
End Sub
 
Private Sub File1_Click()
Label1.Caption = File1.Path + "\" + File1.filename
End Sub
 
Private Sub Form_Load()
If IsDriveReady("M") = "Falsch" Then
Mldg = "Laufwerk ""M:\"" ist nicht vorhanden"
Stil = vbOKOnly
Titel = "Laufwerksfehler / Programm wird beendet"
Antwort = MsgBox(Mldg, Stil, Titel)
End
End If
If IsDriveReady("N") = "Falsch" Then
Mldg = "Laufwerk ""N:\"" ist nicht vorhanden"
Stil = vbOKOnly
Titel = "Laufwerksfehler / Programm wird beendet"
Antwort = MsgBox(Mldg, Stil, Titel)
End
End If
ChDrive "M"
Dir1.Path = "M:\CHG\Todo CHG\ASN"
Dir2 = "M:\CHG\Erledigt CHG\ASN"
Dir3 = "N:\Nike\Gdaten"
Label1.Caption = ""
End Sub
 
Private Sub Import_Click()
AlterName = File1.filename
Neuername = Dir(Dir2 + "\" + File1.filename)
If AlterName = Neuername Then
        Mldg = File1.filename + " schon eingespielt nochmal erzeugen?"   ' Meldung definieren.
        Stil = vbYesNo + vbCritical + vbDefaultButton2  ' Schaltflächen
        Titel = "Nike-ASN doppelte Datei"
        Antwort = MsgBox(Mldg, Stil, Titel)    ' Meldung anzeigen.
        If Antwort = vbYes Then
            Kill (Dir2 + "\" + File1.filename)
            Neuername = "Neuername"
        Else
            Kill (File1.Path + "\" + File1.filename)
        End If
End If
If AlterName <> Neuername Then
    AlterName = File1.Path + "\" + File1.filename
    Neuername = Dir2 + "\" + File1.filename
    Open Dir3 + "\" + File1.filename + ".imp" For Output As #2
    Print #2, "!REMARK       : Nike-ASN Warenbeingang aus Datei: " + File1.filename
    Print #2, "Verband       : Nike-ASN"
    Print #2, "!Init         : 01010110"
    Print #2, ""
    Print #2, "ArtZ„hl       : Ja"
    Print #2, "GRUpdate      : Spez"
    Print #2, ""
    Open File1.Path + "\" + File1.filename For Input As #1
    Do While Not EOF(1)
    Line Input #1, sString
    Zeile = Replace(sString, "/", ".")
    Spliter = Split(Zeile, ",")
    Kopf = Spliter(0)
        If Kopf = "HEADER1" Then
            LieferNr = Spliter(1)
            Datum = Spliter(2)
            Kunde = Spliter(3)
            Karton = Spliter(5)
            GesMe = Spliter(6)
            Gewicht = Spliter(7)
        ElseIf Kopf = "HEADER2" Then
            OrderNr = Spliter(1)
        ElseIf Kopf = "HEADER3" Then
            Zusatztext = Spliter(1)
            Print #2, "VorgArt       : 2"
            Print #2, "BelegNr       : -1"
            Print #2, "ERFDAT        : " + Datum
            Print #2, "MUTDAT        : " + Datum
            Print #2, "ZUSTEXT    [1]: Nike Ordernr: " + OrderNr + "  " + File1.filename
            Print #2, "ZUSTEXT    [2]: Bestelltxt: " + Zusatztext
            Print #2, "ZUSTEXT    [2]: Anz. Kart:" + Karton + "  Stk:" + GesMe + "  Kg:" + Gewicht
            Print #2, "LIEFSNR       : " + LieferNr
            Print #2, "LIEFSDAT      : " + Datum
            Print #2, "SAISON        : -1"
            Print #2, "FILIALE       : 101"
            Print #2, "LIEFER        : 1"
            Print #2, "!CRSORPUT     : BELEG"
            Print #2, ""
        Else
            EAN = Spliter(4)
            Grösse = Spliter(3)
            Menge = Spliter(5)
            Print #2, "EANNR         : " + EAN
            Print #2, "!CRSORPUT     : ARTIKEL"
            Print #2, ""
            Print #2, "PosNR         : -1"
            Print #2, "PosART        : CURRENT"
            Print #2, "TabFIL        : 101"
            Print #2, "TabGroes[1]   : """ + Grösse + """"
            Print #2, "TabMENGE[1]   : " + Menge
            Print #2, "!CRSORPUT     : POSTEN"
            Print #2, ""
        End If
Loop
Close #1
Close #2
Name AlterName As Neuername
End If
File1.Refresh
Label1.Caption = " "
End Sub
 
Public Function Split( _
    ByRef Expression As String, _
    Optional ByRef Delimiter As String = " ", _
    Optional ByVal Count As Long = -1, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare _
  ) As Variant
  Dim DelimiterLen As Long
  Dim index As Long
  Dim Start As Long
  Dim Strings() As String
  Dim StringsCount As Long
  Dim StringsUBound As Long
  Dim StringsPtr As Long
  
  If Count And Len(Expression) > 0 Then
  
    DelimiterLen = Len(Delimiter)
    If DelimiterLen Then
      'Speicher reservieren:
      If Count < 0 Then
        Count = Len(Expression) \ DelimiterLen
      Else
        Count = Count - 1
      End If
      If Count < 2048 Then
        StringsUBound = Count
      Else
        StringsUBound = 1024
      End If
      ReDim Strings(StringsUBound)
      
      'String splitten:
      Start = 1
      For StringsCount = 0 To Count - 1
        'Nächsten Delimiter suchen:
        index = InStr(Start, Expression, Delimiter, Compare)
        If index = 0 Then Exit For
        
        'Ggf. Array vergrößern:
        If StringsCount > StringsUBound Then
          StringsUBound = StringsCount * 2
          ReDim Preserve Strings(StringsUBound)
        End If
        
        'Teilstring speichern:
        Strings(StringsCount) = _
            Mid$(Expression, Start, index - Start)
        Start = index + DelimiterLen
      Next StringsCount
      Strings(StringsCount) = Mid$(Expression, Start)
      
      'Ggf. Array verkleinern:
      If StringsCount < StringsUBound Then _
          ReDim Preserve Strings(StringsCount)
    
    Else
      'Delimiter ist Leerstring:
      ReDim Strings(0)
      Strings(0) = Expression
    End If 'DelimiterLen
    Split = Strings
  
  Else
    'Nichts zu tun:
    Split = Array()
  End If 'Count And Len(Expression) > 0
End Function
Function Replace(Source As String, Find As String, ReplaceStr As String, _
    Optional ByVal Start As Long = 1, Optional Count As Long = -1, _
    Optional Compare As VbCompareMethod = vbBinaryCompare) As String
 
    Dim findLen As Long
    Dim replaceLen As Long
    Dim index As Long
    Dim counter As Long
    
    findLen = Len(Find)
    replaceLen = Len(ReplaceStr)
    ' this prevents an endless Loop
    If findLen = 0 Then Err.Raise 5
    
    If Start < 1 Then Start = 1
    index = Start
    
    ' let's start by assigning the source To the result
    Replace = Source
    
    ' If Find And ReplaceStr strings have same length, it Is possible To
    ' use an optimized algorithm, based On the Mid$ command
    Do
        index = InStr(index, Replace, Find, Compare)
        If index = 0 Then Exit Do
        If findLen = replaceLen Then
            ' If the find And replace strings have same length
            ' we can use the faster Mid$ command
            Mid$(Replace, index, findLen) = ReplaceStr
        Else
            ' Else we must use concatenation
            Replace = Left$(Replace, index - 1) & ReplaceStr & Mid$(Replace, _
                index + findLen)
        End If
        ' skip over the String just added
        index = index + replaceLen
        ' increment the replacement counter
        counter = counter + 1
        ' Note that the Loop Until test will always fail If Count = -1
    Loop Until counter = Count
    
    ' The Next operation serves To keep complete compatibility With
    ' VB6's Replace Function. You can delete it If you prefer.
    If Start > 1 Then Replace = Mid$(Replace, Start)
 
End Function
Public Function IsDriveReady(ByVal Drive As String) As Boolean
 
  On Error Resume Next
  GetAttr Left$(Drive, 1) & ":\"
  
  IsDriveReady = CBool(Err.Number = 0)
  
  On Error GoTo 0
End Function