• 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.

Check op open bestanden

Status
Niet open voor verdere reacties.
D

duco243

Gebruiker
Lid geworden
8 jul 2009
Berichten
67
Beste VBA-ers,


Ik heb een bestand (WHO.xlsm) dat gegevens van 3 andere bestanden inleest, die 3 bestanden moeten dan wel open staan.
De 3 bestanden zijn:

5962.xls
5963.xls
5964.xls

Nu zou ik willen controleren alvorens het inlezen begint of deze bestanden geopend zijn.
Ik heb hiervoor op het forum geen goede oplossing kunnen achterhalen, ik denk dat het zoiets zal zijn:


Dim fileA As String
Dim fileB As String
Dim fileC As String

fileA = "5962.xls"
fileB = "5963.xls"
fileC = "5964.xls"



If (fileA) Is closed Then
retval = MsgBox(fileA.Name & " staan niet open" & vbOK)
If retval = vbOK Then

End If
Next

If fileB Is closed Then
retval = MsgBox(fileB.Name & " staan niet open" & vbOK)
If retval = vbOK Then

End If
Next

If fileC Is closed Then
retval = MsgBox(fileC.Name & " staan niet open" & vbOK)
If retval = vbOK Then

End If
Next


Dit werk niet maar kan iemand dit aanpassen zodat het wel werkt of eventueel een simpelere oplossing geven?


bvd

Duco
 
edmoor zei:
Kijk eens hier:
http://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open-using-vba
Klik om te vergroten...

Dit zou moeten kunnen werken maar heeft nog enkele aanpassingen nodig.
Ik wil graag dat er geen melding komt als het bestand al open is, dus zal de code in dat geval naar de volgende Ret = IsWorkBookOpen("5963.xls") moeten gaan (denk ik).
Er kwam ook een foutmelding met het testen in een regel in de function gedeelte maar komt dit misschien omdat Ret 3x gevalideerd is?


Sub Sample()


Dim Ret

Ret = IsWorkBookOpen("5962.xls")

If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If

Ret = IsWorkBookOpen("5963.xls")

If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If

Ret = IsWorkBookOpen("5964.xls")

If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If

End sub


Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
 
Test deze verkorte versie eens.
Code: 
Sub hsv()
Dim Obj, Wb As Workbook
For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
  On Error Resume Next
    Set Wb = Workbooks(Obj)
 If Err.Number > 0 Then MsgBox "Bestand " & Obj & " niet open"
    On Error GoTo 0
    Set Wb = Nothing
 Next Obj
End Sub
 
HSV zei:
Test deze verkorte versie eens.
Code: 
Sub hsv()
Dim Obj, Wb As Workbook
For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
  On Error Resume Next
    Set Wb = Workbooks(Obj)
 If Err.Number > 0 Then MsgBox "Bestand " & Obj & " niet open"
    On Error GoTo 0
    Set Wb = Nothing
 Next Obj
End Sub
Klik om te vergroten...

Harry bedankt. Dit werk perfect, ik dacht wel dat er iets simpelers zou zijn.
Alleen een dingetje nog, als er een bestand niet open is zou ik willen dat de macro stopt, waar moet dan ergens Quit, Kill, Stop of iets dergelijks komen?
 
Dat kan met:
Code: 
Exit sub

Uitgewerkt ziet het er zo uit.

Code: 
Sub hsv()
Dim Obj, Wb As Workbook
For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
  On Error Resume Next
    Set Wb = Workbooks(Obj)
 If Err.Number > 0 Then 
    MsgBox "Bestand " & Obj & " niet open"
    exit sub
   end if
 Next Obj
Set Wb = Nothing
End Sub
 
Laatst bewerkt:
HSV zei:
Code: 
Sub hsv()
Dim Obj, Wb As Workbook
For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
  On Error Resume Next
    Set Wb = Workbooks(Obj)
 If Err.Number > 0 Then 
    MsgBox "Bestand " & Obj & " niet open"
    exit sub
   end if
 Next Obj
Set Wb = Nothing
End Sub
Klik om te vergroten...

Helaas, dit werkt niet, de macro stopt zonder melding, ik krijg dus de msg box niet meer te zien.
Als ik exit sub weghaal dan zie ik die wel, maar als ik dan op OK klik dan springt ie naar de vba editor met de foutmelding van het ontbrekende bestand.
Ik kan niet goed beredeneren waarom die msg box niet meer verschijnt.
 
Wil je svp niet steeds citeren (quoten) ?

Code: 
Sub hsv_snb()
  on error resume next

  For Each it In Array("5962.xls", "5963.xls", "5964.xls")
    x0=workbooks(it).name
    if err.number <>0 then exit for
  next

  if err.number <>0 then   MsgBox "Bestand " & it & " niet open"
End Sub
 
snb, jouw oplossing kan volgens mij niet (wordt tijdens test ook bevestigd) want met end sub stopt het programma.
De bedoeling is dat het programma alleen stopt als er een van de bestanden niet geopend is, indien alle bestanden open zijn moet het programma gewoon doorgaan

hier even een klein stukje uit de code ter verduidelijking:



sub inlezen()

With Application
.DisplayFullScreen = True
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
.OnKey "{Esc}", ""
' rechtermuisknop uitschakelen
' .CommandBars("Cell").Controls("&Close Full Screen").Visible = False
End With

On Error Resume Next

For Each it In Array("5962.xls", "5963.xls", "5964.xls")
x0 = Workbooks(it).Name
If Err.Number <> 0 Then Exit For
Next

If Err.Number <> 0 Then MsgBox "Bestand " & it & " niet open"
End Sub

OPMERKING: hier ontstaat een foutmelding en zonder end sub stopt het programma niet

Dim i As Integer
With Prog_bar
'SET MIN value to 0
.ProgressBar1.Min = 0
'SET Max value as per your requirement
.ProgressBar1.Max = 10000
.Show vbModeless


etc etc.
 
duco243 zei:
Ik wil graag dat er geen melding komt als het bestand al open is
Klik om te vergroten...

Die code is prima en werkt goed, net als die van snb.
Als je geen melding wil als een document niet open is, waarom zet je dan die MsgBox in je code?
Dan doe je op dat moment toch iets waarvan je wilt dat het wel gebeurt?

De code die je hierboven hebt geplaatst KAN helemaal niet werken.
 
Laatst bewerkt:
De gegeven codes werken prima, maar als jij onder "end sub" nog wat schrijft zonder dat wij het weten en met als opmerking "helaas dit werkt niet" komt, zal je je toch eens achter de oren moeten krabben en beter informatie moeten geven met wat je doet.
 
Hiermee begon ik mijn vraag:


Ik heb een bestand (WHO.xlsm) dat gegevens van 3 andere bestanden inleest, die 3 bestanden moeten dan wel open staan.
De 3 bestanden zijn:

5962.xls
5963.xls
5964.xls

Nu zou ik willen controleren alvorens het inlezen begint of deze bestanden geopend zijn.

Dan lijkt het mij toch logisch dat de code die controleert of de bestanden open zijn wordt gevolgd door de code voor het inlezen....

Voor edmoor: msg box meldt dat er bestanden NIET open zijn, wel open is geen melding en macro gaat door, niet open is melding en macro stopt,
 
De macro stop je niet door er End Sub bij te zetten maar Exit Sub.
 
@duco

Voordat je commentaar gaat leveren kun je veel beter je eerst de allereerste basisbeginselen van VBA eigen maken.
Gebruik bijv. 'VBA voor Dummies' van John Walkenbach.

Je doet er jezelf een plezier mee en voorkomt dat je ondeskundige commentaar potentiële helpers zo irriteert, dat je niet meer geholpen wordt (tenzij je daarop uit bent...).
 
Ik heb het gevoel dat we bijna bij de oplossing zijn.
hsv, snb en edmoor, ik heb end sub door exit sub vervangen en dat werk op zich prima als er bestanden niet geopend zijn, so far so good dus.
Als de bestanden WEL geopend zijn dan gaat er iets fout.

Om het wat eenvoudiger te maken heb ik even een workbook aangemaakt, jullie code er in gezet en uitgebreid een simpele opdracht.
Die opdracht van cel A1 kopieeren doet ie dus niet als alle bestanden geopend zijn.
Wat ontbreekt er nog?


Sub hsv_snb()
On Error Resume Next

For Each it In Array("5962.xls", "5963.xls", "5964.xls")
x0 = Workbooks(it).Name
If Err.Number <> 0 Then Exit For
Next

If Err.Number <> 0 Then MsgBox "Bestand " & it & " niet open"
Exit Sub

Range("A1").Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False

End Sub
 
Die Exit Sub wordt nu ALTIJD uitgevoerd.
En haal die On Error Resume Next eruit en maak een Function van het voorbeeld van snb.
 
Laatst bewerkt:
Nou, ben nog even aan het proberen geweest en nu doet de code het wel.
Deze werkt dus goed:

Sub hsv()
Dim Obj, Wb As Workbook
For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
On Error Resume Next
Set Wb = Workbooks(Obj)
If Err.Number > 0 Then
MsgBox "Bestand " & Obj & " niet open"
Exit Sub
End If
Next Obj
Set Wb = Nothing
Range("A1").Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
End Sub

Allemaal weer bedankt voor jullie hulp en tips,

Duco
 
Heb ik toch nog een paar veranderingen voor je m.b.t. leesbaarheid en error trapping:
Code: 
Sub hsv()
    Dim Obj As Workbook
    Dim Wb  As Workbook
    
    For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")
        On Error Resume Next
        Set Wb = Workbooks(Obj)
        If Err.Number > 0 Then
            MsgBox "Bestand " & Obj & " niet open"
            Exit Sub
        End If
    Next Obj
    
    On Error GoTo 0
    Set Wb = Nothing
    
    Range("A1").Select
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
End Sub

En dan laten we dat kopieer en plakwerk maar even zoals het is, maar voor wat daar gebeurd zouden die laatste 6 regels veranderd kunnen worden in:
[B1] = [A1]
 
Hallo edmoor,

Zojuist een nieuw bestand geopend, jouw code (met de verkorte kopieercode) er in gezet (in module1) en getest maar er komt meteen een foutmelding op de regel

For Each Obj In Array("5962.xls", "5963.xls", "5964.xls")

Tijdens de test waren alle bestanden geopend.


Andere vreemde verschijnselen:

Tijdens het testen van enkele van de aangedragen varianten kwam ik een aantal vreemde zaken tegen, kijk maar eens naar de screenshots

SNAG-2162.jpg

SNAG-2164.jpg

Jouw korte versie voor het kopieeren vind ik geweldig en daarom de volgende vraag:

Is er ook een snellere variant voor gekoppelde cellen, b.v. dat vba op een of andere manier de koppelingen legt?

Toepassing:
Ik heb periodiek een spreadsheet met orderregels in kolommen A tm T, het aantal regels varieert van 30.000 tot 50.000.
In de kolommen daarnaast heb ik koppelingen met die kolommen A tm T gelegd om gegevens te filteren en te totaliseren, dit zijn dus 50000 regels met koppelingen.
Dit werkt goed maar is ontzettend traag vanwege die koppelingen.
Zou dit met VBA sneller kunnen?
 
Laatst bewerkt:
Als je zegt een foutmelding te krijgen is het ook handig er bij te vermelden welke dat dan is. Je andere vragen zal ik vanavond eens naar kijken.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan