• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

sluiten van Excel op de terminalserver "windows server 2012R2"

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.213
Beste,

Ik draai elke nacht een script via Excel en die dan daarna Excel afsluit.
Voorheen op onze oude server geen problemen, maar nu wil hij Excel niet helemaal meer afsluiten op de nieuwe server "Windows server 2012R2"ik gebruik nu de code:

Code: 
ActiveWorkbook.Saved = True
Application.Quit

Weet iemand hoe ik echt excel in zijn geheel kan afsluiten.

HWV
 
Daar is zo niks van te zeggen want die 2 regeltijes code zijn correct. Probeer het eens zo:
Code: 
Application.DisplayAlerts = False
ActiveWorkbook.Saved = True
Application.Quit
 
Excel wordt nog steeds neiet afgesloten

Bedankt voor je bericht Edmoor,

Maar helaas alles wordt afgesloten maar de applicatie Excel blij open staan.
Ik zou echt niet weten waar het aan ligt

HWV
 
Weet je zeker dat dat gaat om hetzelfde Excel proces en niet een ander proces dat is blijven hangen?
 
Het is zeker het zelfde proces die open staat.
Voor de zekerheid had ik al gekeken of er nog niks open is blijven staan.

Het punt is dat als ik enkel de code gebruikt:

Code: 
ActiveWorkbook.Saved = True
Application.Quit

Dat hij wel sluit, enkel in de totaal code dat dit niet wil lukken.

Hieronder de code die ik gebruik, en altijd heb gewerkt

Code: 
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Sub KlantenSplitsenAfnameKaart()

On Error GoTo Err_Knop1_Click

Dim c As Range
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim sh As Object
    
    On Error Resume Next
    
Verwijderen 'maak de map waar de bestanden in staan leeg voor de verse bestanden

bestandenSamenvoegen 'starten macro twee jaren importeren en sorteren
TekstNaarGetallen 'artikelnummer omzetten naar getal i.p.v. tekst

Columns(1) = Columns(15).Value 'kolom P kopie naar kolom A

    Set ws1 = ThisWorkbook.Worksheets("Blad1")
    
    For Each c In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
        
        If WksExists(c.Text) Then
        
            Set ws = ThisWorkbook.Worksheets(c.Text)
            
        Else
        
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = c.Text
        
        End If
        
        c.Resize(, 18).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next

ws1.Select

    For Each sh In ThisWorkbook.Sheets
        If sh.Index > "" Then
                Sheets(sh.Name).Select
                
 Application.DisplayAlerts = False
 Sheets("Blad1").Delete
Application.DisplayAlerts = True

''AfnamekaartMaken 'komt een actie te staan
'========================================================================================
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\GST1- Eenheden1.xls"
    Windows("Opvragen Afname kaart.xlsm").Activate
        Sheets(sh.Name).Select
  
SorteerArtikelNummer

'Plaatsen omschrijving
On Error Resume Next
    For j = 2 To Sheets(sh.Name).Cells(Rows.Count, 4).End(xlUp).Row
    With Workbooks("GST1- Eenheden1").Sheets("Artikelen").Columns(1).Find(Sheets(sh.Name).Cells(j, 4).Value)
  
         .Offset(, 6).Copy
      Sheets(sh.Name).Cells(j, 5).PasteSpecial xlPasteValues
    End With
  Next

 
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\AfnameKaarten\Afnamekaart.xls"
    Windows("Opvragen Afname kaart.xlsm").Activate
        Sheets(sh.Name).Select
        
    Range("B1:N10000").Select
    Selection.Copy
    
Windows("Afnamekaart.xls").Activate
    Sheets("Export").Select
    

    Range("B1").Select
    ActiveSheet.Paste
    Range("B1").Select

Workbooks("GST1- Eenheden1.xls").Close False

Windows("Afnamekaart.xls").Activate
    Sheets("Import").Select
    
Range("A2:A1000").Select
    Selection.ClearContents
    
 UniekeArtikels
   
Windows("Afnamekaart.xls").Activate
  Sheets("Export").Select
Range("A2:A1000").Select
       Selection.Copy
    Sheets("Import").Select
        Range("A3").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
Columns("A:Q").Select
    Selection.Copy
    
Windows("Opvragen Afname kaart.xlsm").Activate
    Sheets(sh.Name).Select
        Range("A1").Select
            Sheets(sh.Name).Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    
 Workbooks("Afnamekaart.xls").Close False
'========================================================================================
  
  Opmaak 'opmaak van de pagina maken
  
Range("A3:A300").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
        End If
    
    Next sh

    For Each ws In ThisWorkbook.Worksheets
           
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.SaveAs Filename:= _
        "\\SERVER1\Data\Verkoop\AfnameKaarten\" & ws.Name & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=True
        ThisWorkbook.Activate
    Next

Workbooks("afname2015.xls").Close False
Workbooks("Opvragen Afname kaart.xlsm").Close False

Exit_Knop1_Click:
Exit Sub
Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click

Application.DisplayAlerts = False
ActiveWorkbook.Saved = True
Application.Quit

End Sub
 
Die code kan nog wat beter: zonder 'select' en zonder 'Activate'

de code bereikt exit sub voor de sluitopdracht voor Excel.
 
Bedankt voor het bericht,

de code bereikt exit sub voor de sluitopdracht voor Excel.
Klik om te vergroten...

Snap ik niet echt wat u er mee bedoeld.

HWV
 
Schakel de ON ERROR's eens tijdelijk uit en zie waar (event.) een fout optreedt als je de code doorloopt via F8.
 
Ik heb de on error uit geschakeld, de enigste melding die ik kreeg was voor het verwijderen van "Blad1"
Daarna doorloop hij het gehele script en laat aan het einde Excel applicatie open staan.

HWV
 
Code aangepast en draait goed

Code: 
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Sub KlantenSplitsenAfnameKaart()

''On Error GoTo Err_Knop1_Click

Dim c As Range
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim sh As Object
    
    'On Error Resume Next
    
Verwijderen 'maak de map waar de bestanden in staan leeg voor de verse bestanden

bestandenSamenvoegen 'starten macro twee jaren importeren en sorteren
TekstNaarGetallen 'artikelnummer omzetten naar getal i.p.v. tekst

Columns(1) = Columns(15).Value 'kolom P kopie naar kolom A

    Set ws1 = ThisWorkbook.Worksheets("Blad1")
    
    For Each c In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
        
        If WksExists(c.Text) Then
        
            Set ws = ThisWorkbook.Worksheets(c.Text)
            
        Else
        
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = c.Text
        
        End If
        
        c.Resize(, 18).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next

ws1.Select

    For Each sh In ThisWorkbook.Sheets
        If sh.Index > "" Then
                Sheets(sh.Name).Select
                
On Error Resume Next
 Application.DisplayAlerts = False
 Sheets("Blad1").Delete
Application.DisplayAlerts = True

''AfnamekaartMaken 'komt een actie te staan
'========================================================================================
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\Batch\GST1- Eenheden1.xls"
    Windows("Opvragen Afname kaart.xlsm").Activate
        Sheets(sh.Name).Select
  
SorteerArtikelNummer

'Plaatsen omschrijving
'On Error Resume Next
    For j = 2 To Sheets(sh.Name).Cells(Rows.Count, 4).End(xlUp).Row
    With Workbooks("GST1- Eenheden1").Sheets("Artikelen").Columns(1).Find(Sheets(sh.Name).Cells(j, 4).Value)
  
         .Offset(, 6).Copy
      Sheets(sh.Name).Cells(j, 5).PasteSpecial xlPasteValues
    End With
  Next

 
Workbooks.Open Filename:="\\SERVER1\Data\automatisering\AfnameKaarten\Afnamekaart.xls"
    Windows("Opvragen Afname kaart.xlsm").Activate
        Sheets(sh.Name).Select
        
    Range("B1:N10000").Select
    Selection.Copy
    
Windows("Afnamekaart.xls").Activate
    Sheets("Export").Select
    

    Range("B1").Select
    ActiveSheet.Paste
    Range("B1").Select

Workbooks("GST1- Eenheden1.xls").Close False

Windows("Afnamekaart.xls").Activate
    Sheets("Import").Select
    
Range("A2:A1000").Select
    Selection.ClearContents
    
 UniekeArtikels
   
Windows("Afnamekaart.xls").Activate
  Sheets("Export").Select
Range("A2:A1000").Select
       Selection.Copy
    Sheets("Import").Select
        Range("A3").Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
Columns("A:Q").Select
    Selection.Copy
    
Windows("Opvragen Afname kaart.xlsm").Activate
    Sheets(sh.Name).Select
        Range("A1").Select
            Sheets(sh.Name).Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    
 Workbooks("Afnamekaart.xls").Close False
'========================================================================================
  
  Opmaak 'opmaak van de pagina maken
  
Range("A3:A300").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
        End If
    
    Next sh

    For Each ws In ThisWorkbook.Worksheets
           
        Sheets(ws.Name).Select
        Sheets(ws.Name).Copy
        ActiveWorkbook.SaveAs Filename:= _
        "\\SERVER1\Data\Verkoop\AfnameKaarten\" & ws.Name & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=True
        ThisWorkbook.Activate
    Next

Application.DisplayAlerts = False
ActiveWorkbook.Saved = True
Application.Quit
End sub



Zo werkt het wel, nu begrijp ik de opmerking van SNB wel.
Ik zal deze code verder bekijken om deze beter te maken: zonder 'select' en zonder 'Activate'


Bedankt voor de ondersteuning.

HWV
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan