VBA Opmaak pagina werkt NIET via task Scheduler

HWV · 7 jan 2017

Beste,

Ik heb een Excel bestand dat elke nacht via een task Scheduler draait op onze server (windows server 2012R2).

1) Via de taak opent hij het bestand, dat zo ingesteld gaat dat gelijk de macro gaat lopen
2) Hij bouw dan een klantenkaart op en slaat deze per klant op de server, wat allemaal goed gaat.

Enkel als ik het via deze taak draait neem hij de VBA opmaak niet mee van het bestand. (dan draait Excel op de achtergrond van de server)
Draai ik de taak op de server zonder dat hij via de task cheduler gaat, dan gaat het wel goed, en gaat de opmaak wel goed.

Hier het gedeelte van de opmaak van de sheet

Code:

'Opmaak van de pagina
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .CenterHeader = "Afname overzicht vergelijk " & Range("C2") & "-" & Range("P2")
        .CenterFooter = "Pagina &P"
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0.118110236220472)
        .TopMargin = Application.InchesToPoints(0.590551181102362)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With

Iemand een idee waar het aan zou kunnen liggen, zou het te maken kunnen hebben dat ik er een wachttijd in moet bouwen?

HWV

edmoor · 7 jan 2017

Zonder de rest van de code te zien is er weinig over te vertellen. Hou er bijvoorbeeld rekeing mee dat een proces vanuit de Task Scheduler geen userprofile heeft, ook niet die van de gebruiker waar dat proces onder draait. De home folder bijvoorbeeld is dan altijd C:\Users\Default en netwerkschijven zullen niet beschikbaar zijn zonder dat je deze koppelt in de de batch file die je waarschijnlijk gebruikt om Excel met dat document te starten.

Maak in de VBA ook een log gedeelte die evt. foutmeldingen naar een log bestand schrijft omdat je anders niet kan zien wat er in dat achtergrond proces gebeurt.

HWV · 7 jan 2017

Zal niet de mooiste code zijn maar het werkt

Beste Edmoor, en rest van het forum.

Hieronder de code die ik nu gebruikt, er zullen wel meer verbetering zijn maar verder als dit ben ik nog niet gekomen:

Code:

Sub StartOpbouwKlantenKaart()

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
   End With
    
On Error Resume Next
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\GST1- Eenheden1.xls"
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\901-Artikelen XXX incl voorraad.xls"

Workbooks("Afnamekaart.xlsm").Sheets("Export").Activate
    
'Openen van alle bestanden in de map
    Dim MyFiles As String
    MyFiles = Dir("\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\*.xlsx")
    Do While MyFiles <> ""
    Workbooks.Open "\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\" & MyFiles
        
'nieuw
Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:S10000").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A1:B1").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A3:A10000").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Kopie").Range("A3:A10000").ClearContents

 Range("A2:Q10000").Copy Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:Q10000")

    ActiveWorkbook.Close False
    
Workbooks("Afnamekaart.xlsm").Sheets("Export").Activate

Worksheets("Export").Range("A2").Select
Range("A2").Select

Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate
Workbooks("Afnamekaart.xlsm").Activate

On Error Resume Next
With Sheets("Export")
For Each cl In [DataExportAantal]
If cl.Offset(0, -3).Value = UCase("C") And cl.Value > 0 Then cl.Value = cl.Value * (-1)
Next
End With
    
Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate

On Error Resume Next
    [uArtikel].ClearContents
    For Each cl In [DataExportArtikel]
         If InStr(C01, UCase(cl.Value)) = 0 Then C01 = C01 & UCase(cl.Value) & "|"
    Next
      Range("a3").Resize(UBound(Split(C01, "|")) + 2, 1).Value = WorksheetFunction.Transpose(Split(C01, "|"))
C01 = ""
[uArtikel].Sort Key1:=Range("A3") 'was a2
Windows("Afnamekaart.xlsm").Activate

'voorraad plaatsen en omschrijving
Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate

[A1] = Worksheets("Export").Range("O2")
[B1] = Worksheets("Export").Range("P2")

Columns("A:A").HorizontalAlignment = xlLeft
    Range("A1").Select
      
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A1:Z1000").Copy
Workbooks("Afnamekaart.xlsm").Sheets("Kopie").Range("A1").PasteSpecial xlValues

Sheets("Kopie").Select
    Sheets("Kopie").Copy

'verwijderen van de laatste regel met #N/A
On Error Resume Next
  With Columns(1)
    .Replace "#N/A", ""
    x = .SpecialCells(xlCellTypeBlanks).Areas.Count
    For j = 1 To x
      .SpecialCells(xlCellTypeBlanks).Areas(1).EntireRow.Delete
    Next
  End With
  
sn = Sheets("Kopie").Cells(1).CurrentRegion.Resize(, 19)
sp = Workbooks("901-Artikelen ZNP incl voorraad.xls").Sheets("Data1").Cells(1).CurrentRegion
sp1 = Workbooks("GST1- Eenheden1.xls").Sheets("Artikelen").Cells(1).CurrentRegion

  For j = 3 To UBound(sn)
    For jj = 1 To UBound(sp1)
      If Trim(LCase(sn(j, 1))) = Trim(LCase(sp1(jj, 1))) Then Exit For
    Next
    If jj <= UBound(sp1) Then
      sn(j, 2) = sp1(jj, 7)
    End If
  Next

  For j = 3 To UBound(sn)
    For jj = 1 To UBound(sp)
      If Trim(LCase(sn(j, 1))) = Trim(LCase(sp(jj, 1))) Then Exit For
    Next
    If jj <= UBound(sp) Then
      sn(j, 18) = sp(jj, 6)
      sn(j, 19) = sp(jj, 15)
    End If
  Next
  
Sheets("Kopie").Cells(1).CurrentRegion.Resize(, 19) = sn

Sheets("Kopie").Range("A:A").HorizontalAlignment = xlLeft

'Opmaak van de sheet
Sheets("Kopie").Activate
'Opmaak van de pagina
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .CenterHeader = "Afname overzicht vergelijk " & Range("C2") & "-" & Range("P2")
        .CenterFooter = "Pagina &P"
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0.118110236220472)
        .TopMargin = Application.InchesToPoints(0.590551181102362)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Application.PrintCommunication = True

Workbooks("GST1- Eenheden1.xls").Close False
Workbooks("901-Artikelen XXX incl voorraad.xls").Close False

'Save1
Dim Bedrijfsnaam
Set Bedrijfsnaam = Worksheets("Kopie").Range("A1")

Dim Naam_rekenaar
Set Naam_rekenaar = Worksheets("Kopie").Range("B1")

Dim Mydate
    Mydate = Date
Dim Datumtekst
    Datumtekst = CStr(Mydate)
    
ChDir "\\SERVER1\Data\Verkoop\AfnameKaarten"
ActiveWorkbook.SaveAs Filename:="\\SERVER1\Data\Verkoop\AfnameKaarten\" & "" & Naam_rekenaar & " (" & Bedrijfsnaam & ").xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close False
    
'Step 4: Next File in the folder/Directory
    MyFiles = Dir
    Loop
   
Workbooks("GST1- Eenheden1.xls").Close False
Workbooks("901-Artikelen ZNP incl voorraad.xls").Close False

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
 Application.Quit
 
End Sub

Groet HWV

edmoor · 7 jan 2017

En door welke actie wordt de functie StartOpbouwKlantenKaart gestart?

De On Error Resume Next zorgt er wel voor dat bij een fout met de volgende regel wordt door gegaan maar lost niet de fout op die optrad. Schrijf dat naar een log bestand want anders weet je niet wat er eventueel fout ging.

HWV · 7 jan 2017

Aanroepen bestand

Beste,

Hier de code voor het aanroepen van het bestand zodra het geopend wordt, deze staat in ThisWorksbook.

Code:

Private Sub Workbook_Open()
StartOpbouwKlantenKaart
End Sub

Private Sub Workbook_Close()
Application.Quit
End Sub

Wat betreft het log bestand, is voor mij een raadsel hoe ik dat moet gaan doen. Daar ben ik niet in thuis.

Het rare is dat als ik het bestand opent op de server dan gaat alles wel goed, en enkel als het op de achtergrond draait niet.

Groet HWV

edmoor · 7 jan 2017

Dat het op de achtergrond niet werkt kan, zoals ik al zei, meerdere oorzaken hebben dus dat is niet zo vreemd. Het log bestand is niets anders dan het openen van een tekst bestand aan het begin van de procedure, waar je op relevante momenten in schrijft met welke actie de procedure bezig is en het resultaat ervan.

Zorg er ook voor dat je volledige lees- en schrijfrechten hebt voor de (verborgen) folder C:\Users\Default.

HWV · 7 jan 2017

Beste,

Bedankt, ik ben nu aan het bekijken hoe ik zo´n login script moet schrijven.
Wel wat gevonden maar die schrijf weg wanneer er iemand is ingelogd meer niet.

Zijn er voorbeelden dan hou ik mij aanbevolen

HWV

edmoor · 7 jan 2017

Niet een login script, een logbestand!

Een voorbeeld in je eigen code (Oranje regels, ook onderin je code). Zo kan je iedere actie in een log bestand schrijven. Ik heb er een paar gedaan, de rest laat ik aan jou. In dit geval wordt er een logbestand gemaakt in dezelfde folder als waar je hoofd document staat en deze heet dan schlog.txt. Zo kan je in dat tekst bestand zien wat er allemaal gebeurde.
Haal wel alle regels met On Error Resume Next eruit! Om de reden die ik al noemde.

Code:

Sub StartOpbouwKlantenKaart()
[COLOR="#FF8C00"]    Dim logbst As Integer
    
    logbst = FreeFile()
    
    Open ThisWorkbook.Path & "\schlog.txt" For Output As #logbst
    Print #logbst, "Start: " & Now()[/COLOR]
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
   End With
    
On Error [COLOR="#FF8C00"]GoTo Schrijflog[/COLOR]

[COLOR="#FF8C00"]Print #logbst, "Openen " & "\\SERVER1\Data\automatisering\Batch\GST1- Eenheden1.xls"[/COLOR]
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\GST1- Eenheden1.xls"

[COLOR="#FF8C00"]Print #logbst, "Openen " & "\\SERVER1\Data\automatisering\Batch\901-Artikelen XXX incl voorraad.xls"[/COLOR]
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\901-Artikelen XXX incl voorraad.xls"

[COLOR="#FF8C00"]Print #logbst, "Activeren werkboek Afnamekaart.xlsm sheet Export"[/COLOR]
Workbooks("Afnamekaart.xlsm").Sheets("Export").Activate
    
'Openen van alle bestanden in de map
    Dim MyFiles As String
    MyFiles = Dir("\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\*.xlsx")
    Do While MyFiles <> ""
    Workbooks.Open "\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\" & MyFiles
        
'nieuw
Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:S10000").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A1:B1").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A3:A10000").ClearContents
Workbooks("Afnamekaart.xlsm").Sheets("Kopie").Range("A3:A10000").ClearContents

 Range("A2:Q10000").Copy Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:Q10000")

    ActiveWorkbook.Close False
    
Workbooks("Afnamekaart.xlsm").Sheets("Export").Activate

Worksheets("Export").Range("A2").Select
Range("A2").Select

Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate
Workbooks("Afnamekaart.xlsm").Activate

On Error Resume Next
With Sheets("Export")
For Each cl In [DataExportAantal]
If cl.Offset(0, -3).Value = UCase("C") And cl.Value > 0 Then cl.Value = cl.Value * (-1)
Next
End With
    
Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate

On Error Resume Next
    [uArtikel].ClearContents
    For Each cl In [DataExportArtikel]
         If InStr(C01, UCase(cl.Value)) = 0 Then C01 = C01 & UCase(cl.Value) & "|"
    Next
      Range("a3").Resize(UBound(Split(C01, "|")) + 2, 1).Value = WorksheetFunction.Transpose(Split(C01, "|"))
C01 = ""
[uArtikel].Sort Key1:=Range("A3") 'was a2
Windows("Afnamekaart.xlsm").Activate

'voorraad plaatsen en omschrijving
Workbooks("Afnamekaart.xlsm").Sheets("Import").Activate

[A1] = Worksheets("Export").Range("O2")
[B1] = Worksheets("Export").Range("P2")

Columns("A:A").HorizontalAlignment = xlLeft
    Range("A1").Select
      
Workbooks("Afnamekaart.xlsm").Sheets("Import").Range("A1:Z1000").Copy
Workbooks("Afnamekaart.xlsm").Sheets("Kopie").Range("A1").PasteSpecial xlValues

Sheets("Kopie").Select
    Sheets("Kopie").Copy

'verwijderen van de laatste regel met #N/A
On Error Resume Next
  With Columns(1)
    .Replace "#N/A", ""
    x = .SpecialCells(xlCellTypeBlanks).Areas.Count
    For j = 1 To x
      .SpecialCells(xlCellTypeBlanks).Areas(1).EntireRow.Delete
    Next
  End With
  
sn = Sheets("Kopie").Cells(1).CurrentRegion.Resize(, 19)
sp = Workbooks("901-Artikelen ZNP incl voorraad.xls").Sheets("Data1").Cells(1).CurrentRegion
sp1 = Workbooks("GST1- Eenheden1.xls").Sheets("Artikelen").Cells(1).CurrentRegion

  For j = 3 To UBound(sn)
    For jj = 1 To UBound(sp1)
      If Trim(LCase(sn(j, 1))) = Trim(LCase(sp1(jj, 1))) Then Exit For
    Next
    If jj <= UBound(sp1) Then
      sn(j, 2) = sp1(jj, 7)
    End If
  Next

  For j = 3 To UBound(sn)
    For jj = 1 To UBound(sp)
      If Trim(LCase(sn(j, 1))) = Trim(LCase(sp(jj, 1))) Then Exit For
    Next
    If jj <= UBound(sp) Then
      sn(j, 18) = sp(jj, 6)
      sn(j, 19) = sp(jj, 15)
    End If
  Next
  
Sheets("Kopie").Cells(1).CurrentRegion.Resize(, 19) = sn

Sheets("Kopie").Range("A:A").HorizontalAlignment = xlLeft

'Opmaak van de sheet
Sheets("Kopie").Activate
'Opmaak van de pagina
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .CenterHeader = "Afname overzicht vergelijk " & Range("C2") & "-" & Range("P2")
        .CenterFooter = "Pagina &P"
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0.118110236220472)
        .TopMargin = Application.InchesToPoints(0.590551181102362)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Application.PrintCommunication = True

Workbooks("GST1- Eenheden1.xls").Close False
Workbooks("901-Artikelen XXX incl voorraad.xls").Close False

'Save1
Dim Bedrijfsnaam
Set Bedrijfsnaam = Worksheets("Kopie").Range("A1")

Dim Naam_rekenaar
Set Naam_rekenaar = Worksheets("Kopie").Range("B1")

Dim Mydate
    Mydate = Date
Dim Datumtekst
    Datumtekst = CStr(Mydate)
    
ChDir "\\SERVER1\Data\Verkoop\AfnameKaarten"
ActiveWorkbook.SaveAs Filename:="\\SERVER1\Data\Verkoop\AfnameKaarten\" & "" & Naam_rekenaar & " (" & Bedrijfsnaam & ").xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close False
    
'Step 4: Next File in the folder/Directory
    MyFiles = Dir
    Loop
   
Workbooks("GST1- Eenheden1.xls").Close False
Workbooks("901-Artikelen ZNP incl voorraad.xls").Close False

    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
[COLOR="#FF8C00"] Print #logbst, "Einde: " & Now()
 Close #logbst[/COLOR]
 Application.Quit
 
[COLOR="#FF8C00"]Schrijflog:
    Print #logbst, Err.Number, Err.Description
    Resume Next[/COLOR]
 
End Sub

snb · 7 jan 2017

Waarom zou je de opmaak in VBA doen als je met een sjabloon dat vooraf 100% geregeld kunt hebben ?

Gebruik een gewoon xlsx bestand met alle opmaak en maak hiervan in VBA een kopie met

Code:

workbooks.add("G:\OF\voorbeeld.xlsx")

nb. Terzijde: In VBA is chdir immer overbodig.

HWV · 7 jan 2017

Het kan soms zo makkelijk zijn

Beste,

Dank voor de hulp hier in, hoe makkelijk kan de oplossing soms zijn.
Idd in de sheet de opmaak al meegeven

De log bestand ga ik wel als nog maken, om te kijken of alles wel draait zoals het moet draaien.

Code:

[COLOR="#FFA07A"]Print #logbst, "Activeren werkboek Afnamekaart.xlsm sheet Export"[/COLOR]
Workbooks("Afnamekaart.xlsm").Sheets("Export").Activate
    
'Openen van alle bestanden in de map
    Dim MyFiles As String
[COLOR="#FFA07A"]Print #logbst, "Openen " & "\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\*.xlsx" [/COLOR]
   MyFiles = Dir("\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\*.xlsx")
[COLOR="#FFA07A"]Print #logbst, "Do While MyFiles <> """ [/COLOR]   
Do While MyFiles <> ""
[COLOR="#FFA07A"]Print #logbst, "Openen " & "\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\" & MyFiles" [/COLOR]
    Workbooks.Open "\\SERVER1\Data\automatisering\AfnameKaarten\Batch klantenkaarten\afnamekaart artikelen\" & MyFiles
        
'nieuw
[COLOR="#FFA07A"]Print #logbst, "Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:S10000").ClearContents" [/COLOR]
Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:S10000").ClearContents

Even ter controle, ,moet het verder op de manier zoals ik hierboven ben verder gegaan.

Groet HWV

edmoor · 7 jan 2017

Nee, dat gaat niet werken i.v.m. de " tekens. Doe het zoals ik deed. Je hoeft niet de exacte opdracht erin te zetten.
Wat je nu heb staan kan wel, maar dan moeten er weer andere dingen gebeuren en zit je niet op te wachten.

HWV · 7 jan 2017

Oke duidelijk.

Enkel toch nog een vraag, hoe doe ik onderstaande dan verwerken in de log bestand

Code:

[COLOR="#FFA07A"]Print #logbst, "[uArtikel].ClearContents"[/COLOR]
    [uArtikel].ClearContents
    
    For Each cl In [DataExportArtikel]
         If InStr(C01, UCase(cl.Value)) = 0 Then C01 = C01 & UCase(cl.Value) & "|"
    Next
      Range("a3").Resize(UBound(Split(C01, "|")) + 2, 1).Value = WorksheetFunction.Transpose(Split(C01, "|"))
C01 = ""
[uArtikel].Sort Key1:=Range("A3") 'was a2

edmoor · 7 jan 2017

Dat kan weer wel zoals het er nu staat

HWV · 7 jan 2017

Beste,

Ik bedoelde eigenlijk onderstaande±

Code:

    For Each cl In [DataExportArtikel]
         If InStr(C01, UCase(cl.Value)) = 0 Then C01 = C01 & UCase(cl.Value) & "|"
    Next
      Range("a3").Resize(UBound(Split(C01, "|")) + 2, 1).Value = WorksheetFunction.Transpose(Split(C01, "|"))
C01 = ""
[uArtikel].Sort Key1:=Range("A3") 'was a2

Ik weet niet of For Each cl In [DataExportArtikel] deze regel ook apart moet komen te staan in een log

Groet HWV

edmoor · 7 jan 2017

Zoiets:

Code:

   [COLOR="#FF8C00"] Print #logbst, "Schonen uArtikel"[/COLOR]
    [uArtikel].ClearContents
    
   [COLOR="#FF8C00"] Print #logbst, "Start loop DataExportArtikel"[/COLOR]
    For Each cl In [DataExportArtikel]
         If InStr(C01, UCase(cl.Value)) = 0 Then C01 = C01 & UCase(cl.Value) & "|"
    Next
    [COLOR="#FF8C00"]Print #logbst, "Einde loop DataExportArtikel"[/COLOR]

HWV · 8 jan 2017

Beste,

Ik had het idee om eerst even een test te doen om te kijken wat er nu gebeurd met de logfile.
Ik krijg er een foutmelding op, ik heb nu dit:

Code:

Sub test_INLOGFILE()
    Dim logbst As Integer
    
    logbst = FreeFile()
    
    Open ThisWorkbook.Path & "\schlog.txt" For Output As #logbst
    Print #logbst, "Start: " & Now()
    
On Error GoTo Schrijflog

Print #logbst, "A1 kopieren naar A2"
[A1] = [A2]
        
'nieuw
Print #logbst, "Leegmaken sheet Export range A2:S10000"
Workbooks("Afnamekaart.xlsm").Sheets("Export").Range("A2:S10000").ClearContents

 Print #logbst, "Einde: " & Now()
 Close #logbst
 
Schrijflog:
[COLOR="#FFA07A"]    Print #logbst, Err.Number, Err.Description[/COLOR]
    Resume Next
End Sub

Hij geef de fout:
Fout 52 Ongeldige bestandsnaam of ongeldige bestandsnummer.

Maar hij schrijf wel de logfile weg.

Start: 8-1-2017 10:22:27
A1 kopieren naar A2
Leegmaken sheet Export range A2:S10000
Einde: 8-1-2017 10:22:27

Groet HWV

edmoor · 8 jan 2017

Mijn fout. Onder Close #LogBst moet nog Exit Sub staan.

HWV · 8 jan 2017

gelukt

:thumb:

Groet HWV

snb · 8 jan 2017

Juist voor dit soort toepassingen (logboeken) is append uitgevonden

Code:

Sub M_snb()
    Open "G:\OF\logboek" For Append As #1
    Print #1, "de eerste regel"
End Sub

VBA Opmaak pagina werkt NIET via task Scheduler

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Verenigingslid

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Inventaris

Terugkerende gebruiker

Verenigingslid

Wij waarderen jouw privacy