VB script voor autorun personal macro on excel csv bestand

Status
Niet open voor verdere reacties.
S

sameh3

Gebruiker
Lid geworden
8 dec 2016
Berichten
10
Hoi Allemaal,

Ik ben niet echt een held met vba of vb scripting maar ik heb een moeilijk probleem op het werk en gaat als volgt:

Ik heb met VBA een macro aangemaakt om een excel csv bestand uit te vouwen en de informatie erin te updaten d.m.v. importeren van txt logging bestand en deze hiervoor te gebruiken in hetzelfde werkbook.

Die CSV bestanden hebben verschillende namen maar ze beginnen allemaal met: ThuisP...... .CSV

Tot zover lukte dit allemaal (gelukkig), maar die macro heb ik als personal macro aangemaakt (in PERSONAL.XLSB) en dit moet dus de csv bestanden gaan bewerken indien die aanwezig zijn in een bepaalde map.
Nu wil ik d.m.v. taakplanner die handeling automatiseren in verschillende tijdstippen per dag (om 10:00 , 14:00, en 18:00 uur) maar die macro is een personal macro en ik kan het niet in active workbook module plaatsen want die bestanden hebben telkens andere naam. Daardoor dacht ik aan VB script. Maar ik kom telkens niet uit, waarschijnlijk omdat het een personal macro is en dat bleek wat lastiger te zijn. Heeft iemand een voorstel om dit op te lossen?
 
Je kunt een apart Excel bestand maken met een AutoOpen macro, en dat bestand laat je dan door de taakplanner starten. Bij het openen ervan wordt de macro uitgevoerd. Eventueel nog automatisch sluiten erbij zodat het Excel bestand niet onnodig open blijft staan.
 
Hoi, Bedankt voor je antwoord. :) ik dacht namelijk dat het makkelijker is om die macro uit te voeren in de csv excel bestand, want die moet zijn bestand naam en tabblad naam behouden. Bovendien als ik een apart excel bestand hiervoor open, dan wordt het een macro enabled bestand, wat niet wenselijk is voor diegene die het ontvangt :(
 
Dat hoeft toch niet? Je kunt toch een macro bestand maken (in een csv kun je sowieso nooit macro's zetten) die het importbestand opent, importeert, joost mag weten wat nog meer uitvoert, het bestand exporteert naar een csv bestand en vervolgens alles afsluit?
 
Sorry hoor als ik totaal als newby overkom, hoe bedoel je een macro bestand maken ? zo`n personal.xlsb bestand? Ik ga ook mijn vraag anders formulieren misschien helpt dat :) : Kan ik een macro vanuit mijn personal.xlsb bestand automatisch laten uitvoeren op verschillende csv bestanden? ik denk dat hiervoor een Private Sub Workbook_Open() regel geldt, ik heb het volgende geprobeerd:

Private Sub Workbook_Open()
CheckNameWorkbook = ActiveWorkbook.Name
FileNameToExecute = "ThuisP*.csv"
If CheckNameWorkbook = FileNameToExecute Then

"my macro"

End Sub
 
Dit is mijn code:

Code: 
Private Sub Workbook_Open()
 CheckNameWorkbook = ActiveWorkbook.Name
 FileNameToExecute = "ThuisP*.csv"
 If CheckNameWorkbook = FileNameToExecute Then
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 2), 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)), TrailingMinusNumbers:=True
    Columns("O:O").Select
    Selection.Cut
    Columns("U:U").Select
    ActiveSheet.Paste
    Columns("J:J").Select
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;\\s-kcl10\zdHl7\zdhl7.txt" _
        , Destination:=Range("$A$1"))
        .Name = "zdhl7"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    ActiveSheet.Range("$A$1:$L$1105").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10, 11, 12), Header:=xlYes
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$L$1105").AutoFilter Field:=1, Criteria1:="PID"
    Columns("D:D").Select
    Cells.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="~", _
        FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
    Selection.ColumnWidth = 26.29
    Columns("D:D").ColumnWidth = 37.57
    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="^", _
        FieldInfo:=Array(Array(1, 2), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:= _
        True
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.ClearContents
    Columns("K:K").Select
    Selection.ClearContents
    Columns("L:L").Select
    Selection.ClearContents
    Columns("M:M").Select
    Selection.ClearContents
    Columns("N:N").Select
    Selection.ClearContents
    Columns("O:O").Select
    Selection.ClearContents
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="&", _
        FieldInfo:=Array(Array(1, 9), Array(2, 2), Array(3, 2)), TrailingMinusNumbers:= _
        True
    Columns("I:I").Select
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="^", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
        2), Array(6, 9), Array(7, 9)), TrailingMinusNumbers:=True
    Columns("K:K").Select
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "=(RC[-4]&"" ""&RC[-3]&"" ""&RC[-2])"
    Range("L1").Select
    Selection.AutoFill Destination:=Range("L1:L2000"), Type:=xlFillDefault
    Range("L1:L2000").Select
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="~", _
        FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
    Columns("O:O").Select
    Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="^", _
        FieldInfo:=Array(Array(1, 2), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:= _
        True
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="^", _
        FieldInfo:=Array(Array(1, 2), Array(2, 9), Array(3, 9)), TrailingMinusNumbers:= _
        True
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]&"" ""&"" ""&RC[-1])"
    Range("P1").Select
    Selection.AutoFill Destination:=Range("P1:P2000"), Type:=xlFillDefault
    Range("P1:P2000").Select
    Columns("O:O").Select
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.ScrollColumn = 13
    Columns("Q:Q").Select
    Selection.Copy
    Columns("N:N").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("M:M").Select
    Selection.Copy
    Columns("L:L").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.ClearContents
    Sheets(1).Select
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],Blad2!C[-7]:C[3],11,TRUE)"
    Selection.AutoFill Destination:=Range("K1:K100"), Type:=xlFillDefault
    Range("K1:K100").Select
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("L:L").Select
    Selection.Copy
    Columns("K:K").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.ClearContents
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Blad2!C[-4]:C[6],9,TRUE)"
    Range("H1").Select
    Selection.AutoFill Destination:=Range("H1:H100"), Type:=xlFillDefault
    Range("H1:H100").Select
    ActiveWindow.SmallScroll Down:=-105
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Copy
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.ClearContents
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],Blad2!C[-5]:C[5],10,TRUE)"
    Selection.AutoFill Destination:=Range("I1:I100"), Type:=xlFillDefault
    Range("I1:I100").Select
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:J").Select
    Selection.Copy
    Columns("I:I").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.ClearContents
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],Blad2!C[-6]:C[4],8,TRUE)"
    Selection.AutoFill Destination:=Range("J1:J100"), Type:=xlFillDefault
    Range("J1:J100").Select
    ActiveWindow.SmallScroll Down:=-99
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("K:K").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]&RC[-1])"
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D100"), Type:=xlFillDefault
    Range("D1:D100").Select
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Application.DisplayAlerts = False
    Sheets(2).Select
    ActiveWindow.SelectedSheets.Delete
    Sheets(2).Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
End If
For Each w In Application.Workbooks
    w.Save
Next w
Application.Quit
End Sub
 
Laatst bewerkt:
Doe ons een lol en gooi bovenstaande code in de CODE tags; hier is geen doorkomen aan....
Bericht aanpassen, code selecteren en de knop ( # ) aanklikken.
 
yes sir, sorry wist niet hoe ik een code invoer. Eerst keer namelijk op helpmij.nl :D
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan