Automatisch openen bestand uit map.

Scorpio33 · 1 jul 2009

Geachte helpers,

Ik ben bezig om via een vba een ander workbook te openen via bepaalde celwaarden. Naderhand moet het workbook gaan controleren of bepaalde cellen overeen komen met dezelfde bepaalde cellenwaarden van het te openen workbook.

Dit is wat ik tot nu toe heb kunnen maken. Het probleem zit 'm echter in "Dossiernummer" dit is bij elk te openen bestand anders en staat ook niet in het workbook. Het probleem undersquare kan ook een probleem geven maar dat weet ik pas als het eerste probleem is opgelost.
Het bereik van de dossiernummers ligt tussen 0 en 700. De undersquares zitten ook in de bestandsnaam van het te openen bestand maar ik ben er niet zeker van of deze ook in de code moeten staan om het bestand te kunnen openen.

Private Sub CommandButton7_Click()
Application.DisplayAlerts = False
Dim naam1 As String
Dim Voorletters As String
Dim Werkplek As String
Dim Geboortedatum As String
Dim Werkplek As Variant
Dim path As String
Dim OpenFilename As Variant
naam1 = [E1]
Registratienummer = [D1]
Geboortedatum = [J1]
Voorletters = [F1]
path = "C:\Testen\"
Workbooks.Open Filename = "naam1 & "_" & Voorletters & "_" & Dossiernummer & "_" & Werkplek & "_" & Geboortedatum "
Application.DisplayAlerts = True

End Sub

Alvast bedankt voor het kijken.

enijhuis · 1 jul 2009

Hoe bepaal je dan welk dossiernummer je gaat gebruiken?
Heb je een voorbeeld van bron- en doelbestand (of een voorbeeld van een te openen bestandsnaam)?
Wat is het formaat van de extensie die je opent? xls, xts of beide?
Wanneer zet je trouwens de DisplayAlerts weer op True?

Scorpio33 · 1 jul 2009

Het dossiernummer zit gewoon in de bestandsnaam bijvoorbeeld: Janssen_C.G._110_121_6-4-1948_.xls
De bestanden kunnen helaas niet meegezonden worden vanwege gevoelige informatie. Dit is er voor mij ook niet uit te halen.
Het te openen bestand is altijd .xls
De DisplayAlerts moeten uiteraard in het begin van de code staan en aan het eind weer op true gezet worden.

enijhuis · 1 jul 2009

Maar nogmaals: Hoe bepaal je dan welk dossiernummer je gaat gebruiken?
Moeten de bestanden stuk voor stuk worden gecontroleerd of in batch?
Wat is het uiteindelijke doel van CommandButton7_Click?

Warme bakkertje · 1 jul 2009

Voor Naam1,Voorletters en Geboortedatum geef je een cel op met de waarde. Welke cellen gebruik je voor Dossiernummer en werkplek ? Zolang deze niet gedefinieërd zijn zal dit niet werken.

Mvg

Rudi

Scorpio33 · 1 jul 2009

De bestanden in de map test moeten stuk voor stuk worden gecontroleerd. Hierin staan zo'n 700 bestanden.
De bestandsnaam die gezocht moet worden staat dus in verschillende kolommen in rij 1. Het dossiernummer staat niet in het bestand wat controleerd maar wel in de bestandsnaam van het te controleren bestand. Dit is dus variabel en ligt tussen 0 en 700.

Scorpio33 · 1 jul 2009

Warme bakkertje zei:
Voor Naam1,Voorletters en Geboortedatum geef je een cel op met de waarde. Welke cellen gebruik je voor Dossiernummer en werkplek ? Zolang deze niet gedefinieërd zijn zal dit niet werken.

Mvg

Rudi

In de oorspronkelijke vraag stonden twee foutjes deze heb ik aangepast. Eerste fout was de DisplayAlerts. De tweede dat de werkplek niet gedefineerd was. Nu zit ik dus alleen nog met het probleem dat dossiernummer niet is gedefineerd in het bestand wat controleerd, en moet liggen tussen 0 en 700.

Warme bakkertje · 1 jul 2009

Code:

Private Sub CommandButton7_Click()
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\Testen\" & [E1] & "_" & [F1] & "_" & Dossiernummer & "_" & Werkplek & "_" & [J1] & ".xls"
Application.DisplayAlerts = True
End Sub

Dit volstaat normaal als je dossiernummer en werkplek vervangt door de respectievelijke cellen, maar hoe ga je duidelijk maken welk dossiernummer het juiste is?

Mvg

Rudi

Scorpio33 · 1 jul 2009

Het heeft even geduurd en wat verduidelijking van mijn kant gevergd. Maar nu zijn we bij de essentie van mijn vraag. Hoe zorg ik ervoor wel dossiernummer het juiste is?

Scorpio33 · 3 jul 2009

Oke ik heb de werkplek en het dossiernummer aangepast de werkplek is een respectivelijke cel. nl

Code:

Private Sub CommandButton7_Click()
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\Testen\" & [E1] & "_" & [F1] & "_" & [L1:L701] & "_" & [D1]& "_" & [J1] & ".xls"
Application.DisplayAlerts = True
End Sub

Maar krijg nu de melding Fout 13 tijdens uitvoering:
typen komen niet met elkaar overeen.

Ik begrijp dat dit ligt aan het dossiernummer. Maar hoe los ik dit op??
Zoals enijhuis al vroeg. De bestanden moeten stuk voor stuk gecontroleerd worden.
De naam1, de Voorletters, de Werkplek en de Geboortedatum zijn gedefineerd.
Het dossiernummer daarintegen is een gedeelte van de kolom. De code moet de hele kolom nakijken of de bestandsnaam overeenkomt, eerst met cel L1. Komt dit niet overeen dan moet er gekeken worden of cel L2 overeen komt. enz.enz.enz.

snb · 3 jul 2009

Code:

Private Sub CommandButton7_Click()
  With Thisworkbook.sheets(1)
    for each cl in [COLOR="Blue"].columns(12).specialcells(xlcelltypeconstants)[/COLOR]
      Workbooks.Add "C:\Testen\" &[B][COLOR="blue"] .[[/COLOR][/B]E1] & "_" &[B][COLOR="blue"] .[[/COLOR][/B]F1] & "_" & cl.value & "_" & [B][COLOR="blue"].[/COLOR][/B][D1]& "_" &[B][COLOR="blue"] .[/COLOR][/B][J1] & ".xls"
      Stop
    next
  End With
End Sub

Scorpio33 · 6 jul 2009

Code:

Private Sub CommandButton7_Click()
  With Thisworkbook.sheets(1)
    for each cl in .columns(12).specialcells(xlcelltypeconstants)
      Workbooks.Add "C:\Testen\" & .[E1] & "_" & .[F1] & "_" & cl.value & "_" & .[D1]& "_" & .[J1] & ".xls"
      Stop
    next
  End With
End Sub

Het lijkt erop dat er op deze manier alleen in de eerste cel gekeken wordt naar het dossiernummer. echter moet er in cel L1 gekeken worden naar het dossiernummer, komt dit niet overeen dan moet er in cel L2 gekeken worden. Dit moet net zo lang gebeuren totdat de complete bestandsnaam is gevonden.
Ik krijg namelijk "Fout 1004 tijdens uitvoering"
De bestandsnaam kan niet worden gevonden.
Controleer de spelling en de locatie van het bestand.

Voor zover ik het nu kan zien wordt er alleen in cel 1 gekeken omdat in de bestandsnaam waar naar gezocht wordt dossiernummer op 1 staat.
De bestandsnaam komt voor de rest helemaal overeen. Echter moet het dossier nummer tussen de 0 en 700 liggen. Deze nummers staan in kolom 12 (L)

Scorpio33 · 6 jul 2009

Scorpio33 zei:
Code:

Private Sub CommandButton7_Click() With Thisworkbook.sheets(1) for each cl in .columns(12).specialcells(xlcelltypeconstants) Workbooks.Add "C:\Testen\" & .[E1] & "_" & .[F1] & "_" & cl.value & "_" & .[D1]& "_" & .[J1] & ".xls" Stop next End With End Sub

Het lijkt erop dat er op deze manier alleen in de eerste cel gekeken wordt naar het dossiernummer. echter moet er in cel L1 gekeken worden naar het dossiernummer, komt dit niet overeen dan moet er in cel L2 gekeken worden. Dit moet net zo lang gebeuren totdat de complete bestandsnaam is gevonden.
Ik krijg namelijk "Fout 1004 tijdens uitvoering"
De bestandsnaam kan niet worden gevonden.
Controleer de spelling en de locatie van het bestand.

Voor zover ik het nu kan zien wordt er alleen in cel 1 gekeken omdat in de bestandsnaam waar naar gezocht wordt dossiernummer op 1 staat.
De bestandsnaam komt voor de rest helemaal overeen. Echter moet het dossier nummer tussen de 0 en 700 liggen. Deze nummers staan in kolom 12 (L)

Voor de duidelijkheid misschien toch maar een bijlage.

enijhuis · 6 jul 2009

Zo dan:

Code:

Private Sub CommandButton7_Click()

    Const NR = 12
    
    Dim fso As Object
    Dim rCell As Range
    Dim sFile As String
    Dim oBook As Workbook
    
    On Error GoTo ErrH
    
    'Instantieer een FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With ThisWorkbook.Sheets(1)
        'Volgende statement werkt niet daar er ook formules voorkomen in kolom 12:
        'For Each rCell In .Columns(NR).SpecialCells(xlCellTypeConstants)  '  Daarom:
        For Each rCell In Intersect(.Columns(NR), .UsedRange)
        
            sFile = "C:\Testen\" & .[E1] & "_" & .[F1] & "_" & rCell.Value & "_" & .[D1] & "_" & .[J1] & ".xls"
            'Check of het bestand bestaat
            If fso.FileExists(sFile) Then
                Set oBook = Workbooks.Add(sFile)
                Exit For
            End If
        Next
    End With
    
    If oBook Is Nothing Then
        Err.Raise 666, , "Bestand niet aangetroffen:" & vbCr & sFile
    End If
    
CleanUp:
    Set fso = Nothing
    Exit Sub
ErrH:
    MsgBox Err.Description, vbExclamation
    Resume CleanUp
End Sub

Ik vind CommandButton7_Click trouwens niet een erg beschrijvende naam.
En waarom sla je 700 gevoelige bestanden op de C-schijf op? Wat nou als Windows crashed? Altijd programma-en data-bestanden op gescheiden partities oplaan.

Succes ermee!

Scorpio33 · 6 jul 2009

Helaas ook dit werkt niet naar behoren. Nu komt de melding naar voren:
"Bestand niet aangetroffen:
C:\Testen\Krous_M.L._700_225_19-12-1979.xls

Het lijkt er op dat er nu alleen naar de laatst gevulde cel kijkt (700 dus) voor het dossiernummer. Maar er moet in alle tussenliggende cellen ook gekeken worden.

En waarom sla je 700 gevoelige bestanden op de C-schijf op? Wat nou als Windows crashed? Altijd programma-en data-bestanden op gescheiden partities oplaan.

Dit is niet het geval, maar ik kan de servernaam hier niet tentoonspreiden in verband met eventuele gevoelige informatie. De programma's en databestanden zijn wel degelijk gescheiden.

enijhuis · 6 jul 2009

Bij mij werkt het anders prima in jouw meegestuurde voorbeeldje. Ik hoop niet dat jouw origineel er anders uit ziet anders zitten we elkaars tijd te verdoen.

Zo dan:

Code:

Private Sub CommandButton7_Click()

    Const NR = 12
    Const ROWSTART = 1
    
    Dim fso As Object
    Dim sFile As String
    Dim oBook As Workbook
    Dim iRow As Integer
    
    On Error GoTo ErrH
    
    iRow = ROWSTART
    
    'Instantieer een FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With ThisWorkbook.Sheets(1)
        'Volgende statement werkt niet daar er ook formules voorkomen in kolom 12:
        'For Each rCell In .Columns(NR).SpecialCells(xlCellTypeConstants)  '  Daarom:
        Do While .Cells(iRow, NR) <> vbNullString
        
            sFile = "C:\Testen\" & .[E1] & "_" & .[F1] & "_" & .Cells(iRow, NR) & "_" & .[D1] & "_" & .[J1] & ".xls"
            'Check of het bestand bestaat
            If fso.FileExists(sFile) Then
                Set oBook = Workbooks.Add(sFile)
                Exit Do
            End If
            iRow = iRow + 1
        Loop
    End With
    
    If oBook Is Nothing Then
        Err.Raise 666, , "Bestand niet aangetroffen:" & vbCr & sFile
    End If
    
CleanUp:
    Set fso = Nothing
    Exit Sub
ErrH:
    MsgBox Err.Description, vbExclamation
    Resume CleanUp
End Sub

Let op! De ROWSTART start op 1 (net als in jouw voorbeeld) dus indien nodig aanpassen.

Scorpio33 · 6 jul 2009

Nu doet hij wat er moet gebeuren:thumb:

Hartelijk dank voor de medewerking

enijhuis · 6 jul 2009

Weet je zeker dat Sheets(1) klopt? Wijzig daarom N_A_A_M__T_A_B_B_L_A_D door de naam van Sheets(1).
Weet je zeker dat je in kolom 12 doortelt tot 700?
Verder toon ik een derde manier om de nummer-range te definiëren:

Code:

Private Sub CommandButton7_Click()

    Const NR = 12
    
    Dim oSheet As Worksheet
    Dim fso As Object
    Dim rCell As Range
    Dim rCells As Range
    Dim sFile As String
    Dim oBook As Workbook
    
    On Error GoTo ErrH
    
    Set oSheet = ThisWorkbook.Worksheets("N_A_A_M__T_A_B_B_L_A_D")
    
    'Instantieer een FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With oSheet
    
        Set rCell = .Cells(1, NR)
        Set rCells = rCell.Resize(rCell.End(xlDown).Row, 1)
    
        'Volgende statement werkt niet daar er ook formules voorkomen in kolom 12:
        'For Each rCell In .Columns(NR).SpecialCells(xlCellTypeConstants)  '  Daarom:
        For Each rCell In rCells
        
            sFile = "C:\Testen\" & .[E1] & "_" & .[F1] & "_" & rCell.Value & "_" & .[D1] & "_" & .[J1] & ".xls"
            'Check of het bestand bestaat
            If fso.FileExists(sFile) Then
                Set oBook = Workbooks.Add(sFile)
                Exit For
            End If
        Next
    End With
    
    If oBook Is Nothing Then
        Err.Raise 666, , "Bestand niet aangetroffen:" & vbCr & sFile
    End If
    
CleanUp:
    Set fso = Nothing
    Exit Sub
ErrH:
    MsgBox Err.Description, vbExclamation
    Resume CleanUp
End Sub

Scorpio33 · 6 jul 2009

Alles klaar. Hij doet precies wat ik wil.

Nogmaals hartelijkdank voor de medewerking.:thumb:

Warme bakkertje · 6 jul 2009

Nu ga je toch telkens bericht krijgen dat het bestand niet gevonden is aangezien "/" toch een ongeldig teken is in een bestandsnaam of mis ik hier iets ?

Mvg

Rudi

Automatisch openen bestand uit map.

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Gebruiker

Meubilair

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Gebruiker

Bijlagen

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Meubilair

Wij waarderen jouw privacy