VBA End If en Case geeft foutmelding

[alexander321]

Beste Mensen,

Ik krijg een export van een x-aantal txt bestanden.
Deze worden aan elkaar geplakt middels een macro.
Ik wil middels een inputbox een variabele krijgen.
Ik wil ook een loop, zie onderstaand.
Helaas werkt dit zo niet.
Wie kan me verder helpen?

Alvast dank!

Sub Folderevaluatie()
Plaats = "xxx"
Foldernr = InputBox("Geef het folderNUMMER op.")

' Vraag welke folders geevalueerd moeten worden
    Dim Msg, Title As String
    Dim MyInput As Integer
     ' Definieer het bericht
    Msg = " " _
    & vbNewLine & "Geef 1 voor F, H, I" _
    & vbNewLine & "Geef 2 voor F, H, I, S"
     ' Definieer de titel
    Title = "Welke Foldercodes wil je evalueren?"
    MyInput = InputBox(Msg, Title)
    Select Case MyInput
    Case 1
    ' Geef de variabelen in de gedefinieerde reeks op
            For Each cl In Array(1, 2, 3)
                If cl = 1 Then
                Foldercode = " F"
                ElseIf cl = 2 Then
                Foldercode = " H"
                ElseIf cl = 3 Then
                Foldercode = " I"
                End If
    Case 2
    ' Geef de variabelen in de gedefinieerde reeks op
            For Each cl In Array(1, 2, 3, 4)
                If cl = 1 Then
                Foldercode = " F"
                ElseIf cl = 2 Then
                Foldercode = " H"
                ElseIf cl = 3 Then
                Foldercode = " I"
                ElseIf cl = 4 Then
                Foldercode = " S"
                End If
    End Select
' Open het juiste bestand
    BestandTXT = Plaats & Foldernr & Foldercode
    Workbooks.OpenText Filename:=BestandTXT, Origin:= _
    xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1))
' Voeg een eerste kolom toe
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
' Geef in eerste kolom de letter van de foldercode
    ActiveCell.Value = Foldercode
    Range("A1").Select
' Maak een hulpkolom voor kopieren foldercode
    Columns("B:B").Select
    Selection.Copy
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
' Selecteer de gewenste gegevens en kopieer naar beneden door
    Range("A1:B1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
' Verwijder de hulpkolom
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
' Geef kolomtitel
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Foldercode"
    Range("A1").Select
' Vervang de . door , ivm rekenwerk
    Range("K2:AG2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
' Sla het bestand op
    ActiveWorkbook.Save
' Sluit het bestand
    Application.DisplayAlerts = False
        ActiveWorkbook.Close
    Application.DisplayAlerts = True
   Next

MsgBox "Klaar"

End Sub

 

[Cobbe]

Je moet je code tussen codetags zetten op het forum aub.


Test hem zo eens:

Sub Folderevaluatie()
    Plaats = "xxx"
    Foldernr = InputBox("Geef het folderNUMMER op.")

    ' Vraag welke folders geevalueerd moeten worden
    Dim Msg, Title As String
    Dim MyInput As Integer
    ' Definieer het bericht
    Msg = " " _
          & vbNewLine & "Geef 1 voor F, H, I" _
          & vbNewLine & "Geef 2 voor F, H, I, S"
    ' Definieer de titel
    Title = "Welke Foldercodes wil je evalueren?"
    MyInput = InputBox(Msg, Title)
    Select Case MyInput
    Case 1
        ' Geef de variabelen in de gedefinieerde reeks op
        For Each cl In Array(1, 2, 3)
            If cl = 1 Then
                Foldercode = " F"
            ElseIf cl = 2 Then
                Foldercode = " H"
            ElseIf cl = 3 Then
                Foldercode = " I"
            End If
        Next
    Case 2
            ' Geef de variabelen in de gedefinieerde reeks op
            For Each cl In Array(1, 2, 3, 4)
                If cl = 1 Then
                    Foldercode = " F"
                ElseIf cl = 2 Then
                    Foldercode = " H"
                ElseIf cl = 3 Then
                    Foldercode = " I"
                ElseIf cl = 4 Then
                    Foldercode = " S"
                End If
             Next
    End Select
            ' Open het juiste bestand
            BestandTXT = Plaats & Foldernr & Foldercode
            Workbooks.OpenText Filename:=BestandTXT, Origin:= _
                               xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                               xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
                               Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
                                                                                          Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
                                                                                          Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
                                                                                                                                                                                   , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
                                                                                                                                                                                   Array(22, 1))
            ' Voeg een eerste kolom toe
            Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            ' Geef in eerste kolom de letter van de foldercode
            Range("A1").Value = Foldercode
            Range("A1").Select
            ' Maak een hulpkolom voor kopieren foldercode
            Columns("B:B").Copy
            Columns("A:A").Insert Shift:=xlToRight
            ' Selecteer de gewenste gegevens en kopieer naar beneden door
            Range("A1:B1").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range(Selection, Selection.End(xlDown)).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            ' Verwijder de hulpkolom
            Columns("A:A").Select
            Selection.Delete Shift:=xlToLeft
            ' Geef kolomtitel
            Range("A1").FormulaR1C1 = "Foldercode"
            ' Vervang de . door , ivm rekenwerk
            Range("K2:AG2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
                              SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                              ReplaceFormat:=False
            ' Sla het bestand op
            ActiveWorkbook.Save
            ' Sluit het bestand
            Application.DisplayAlerts = False
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
        

        MsgBox "Klaar"

    End Sub

 

[alexander321]

Helaas Cobbe, dit werkt niet. Het is namelijk de bedoeling dat hij voor elke foldercode bestanden gaat openen, vandaar dat next volgens mij aan ook onderaan moet staan.

 

[VenA]

In aanvulling van @Cobbe maak van je code eerst een iets leesbaars. Dus op de juiste plekken inspringen en het dan tussen tags hier plaatsen. Je kan je eerste berichtje wijzigen en daar de leesbare versie neerzetten.

In je Case 1 gebruik je een For die de hele code zou moeten uitvoeren. Maar dat werkt niet om dat de FOR onderdeel is van Case1 en dus afgesloten moet worden. Dit ipv de case select doet het zelfde:

Sub Folderevaluatie1()
Plaats = "xxx"
Foldernr = InputBox("Geef het folderNUMMER op.")

' Vraag welke folders geevalueerd moeten worden
Dim Msg, Title As String
Dim MyInput As Integer
    ' Definieer het bericht
Msg = " " _
    & vbNewLine & "Geef 1 voor F, H, I" _
    & vbNewLine & "Geef 2 voor F, H, I, S"
    ' Definieer de titel
    Title = "Welke Foldercodes wil je evalueren?"
    MyInput = InputBox(Msg, Title)
    For i = 1 To MyInput + 2
        If i = 1 Then
            Foldercode = " F"
        ElseIf i = 2 Then
            Foldercode = " H"
        ElseIf i = 3 Then
            Foldercode = " I"
        ElseIf i = 4 Then
            Foldercode = " S"
        End If
        
        Jouw code
    
    Next i
    MsgBox "Klaar"
End Sub

 

[alexander321]

Helaas is dit ook niet het juiste.
Nu gaat hij het bestandje Foldernummer F.txt 3 x openen ipv de 3 afzonderlijke bestandjes.
Wat mijn bedoeling dus is;
Ik geef middels de Inputbox aan hoeveel en welke txt-bestandjes moeten worden geopend en bewerkt.
Dat is dus bij keuze 1 drie txt-bestandjes, bij keuzen 2 vier en komt dadelijk ook bij keuze 3 vijf etc...

 

[VenA]

Dan heb je het denk ik niet correct toegepast. Ik zie wel dat ik een aantal cl ben vergeten aan te passen in i (heb ik aangepast). Maar dan nog is i = 1 maar één keer waar en zal het bestand niet drie keer geïmporteerd worden.

 

[alexander321]

Hoi VenA, dank!
Nu werkt het!!

 

[snb]

Om alle txt bestanden in folder G:\OF welker naam met "test' beginnen te integreren in 1 txt bestand:

Sub M_snb()
   shell "cmd /c copy G:\OF\test*.txt G:\OF\integratie.txt"
End Sub

 

[alexander321]

snb dank voor deze snelle oplossing, maar helaas zijn in de 3 txt bestanden niet het Foldernr opgenomen, vandaar dat ik het txt bestandje open, een nieuwe eerste kolom toevoeg met foldernummer en daarna weer sluit, om ze daarna allemaal onder elkaar te plakken.

 

[snb]

Ik begrijp niets van wat je zegt (folders hebben een naam, geen nummer, bijv.)
Beschrijf eens stap voor stap wat er moet gebeuren en waar de bestanden staan.

 

[alexander321]

snb, zoals ik al aangaf is de macro nu werkend. een folder bij mij is ook echt een reclamefoldernummer.
Ik heb hem nu werkend zoals ik zou willen

Dank voor iedereen die mee heeft gedacht! :thumb: