Automatisch inlezen van bestandsnamen (FACTUURSYSTEEM)

[Soppuh]

Goedemiddag,

Ik ben bezig een offertesysteem te maken in excel.
Als ik een calculatie maak voor een product, sla ik de calculatie en de offerte op onder een factuurnummer, allemaal in 1 map.
Nu wil ik dat alle offertes die in die ene map staan op onze server, in een excel tabblad weergegeven worden in 1 lijst.
Het moet wel automatisch zijn. Als ik een nieuwe calculatie maak en de offerte ga opslaan, moet deze eigenlijk gelijk in de lijst er bij komen te staan zonder dat ik zelf nog op knoppen hoef te klikken of andere handelingen moet uitvoeren.
Als ik het hele calculatie bestand na een dag calculeren niet ga opslaan (dus de hele lijst met offertes niet fysiek in excel blijft staan, maar wel in de map), moet de volgende dag, of na 2 minuten, bij het openen van het calculatie bestand, gewoon automatisch weer alle offertes in de lijst komen staan.

Heeft iemand enig idee hoe ik zoiets kan realiseren?

Alvast bedankt.

Frank

 

[Quiby]

is example 1 van de volgende links misschien een oplossing.
http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/#Jump1

Wanneer je de macro dan de naam "Auto_open" geeft zal de macro automatisch gestart worden wanneer je het bestand opent

 

[wampier]

Wat excel automatisch kan doen is gelimiteerd door de "events" waarvan je op de hoogte wordt gesteld.

Je kunt dus wel een handeling doen bij het openen, saven, e.d.. Echter automatisch reageren op nieuwe bestanden kan bijvoorbeeld niet.

Je kunt de lijst wel opnieuw genereren de volgende keer dat je de file opent / saved / print / e.d., maar updaten terwijl je in de file bezig bent is lastig en zou ik ook afraden vanwege de belasting die dat op je systeem geeft en potentiële conflicten gedurende het gebruik van zo'n macro.

 

[Soppuh]

Dus zodra ik klaar ben met het calculeren van een product, en ik de offerte en calculatie wil opslaan als pdf d.m.v. een macro button, dan zou het wel kunnen dat de lijst vernieuwd wordt?

 

[wampier]

Dat is inderdaad een mogelijkheid en waarschijnlijk de beste plaats om iets dergelijks te bereiken.

 

[Soppuh]

Duidelijk, dan kan ik gewoon die code die op de website staat die Quiby heeft doorgegeven gewoon aan die knop hangen, en dan het moeten lukken dus. We gaan dat straks of morgen vroeg eens proberen! Bedankt!

 

[Soppuh]

Goedemiddag,

Ik heb onderstaande code even geprobeerd, en hij werkt. Alleen zitten er nog wel een paar haken en ogen aan die ik er nog graag uit wil. Alleen weet ik niet hoe ik dat voor elkaar moet krijgen.
* Ik heb 8 verschillende calculatie tabbladen. Als ik op een tabblad voor een bepaald product een calculatie heb gemaakt, klik ik op een knop dat de calculatie wordt opgeslagen en een offerte sheet. Wel allebei in verschillende mappen.
De offerte komt in de map Offertes, de calculatie komt in de map Calculaties. Beide bestanden worden weggeschreven onder het offertenummer, geen probleem. Maar de lijst met offertes is een ander tabblad genaamd "Offertelijst".
De "Opslaan knop zit dus op 8 verschillende tabbladen, maar als ik daar op klik, moet het tabblad "Offertelijst" ook vernieuwd worden zodat daar de nieuwe offerte ook bij komt te staan. Is dit mogelijk? Zo ja, hoe?
* Met onderstaande code wordt ook de extensie (.pdf in mijn geval) weergegeven. I.v.m. volg nummers moet alleen de bestandsnaam weergegeven worden zonder extensie. Hoe fix ik dat?
* Het path dat weergegeven wordt, moet een hyperlink worden naar de offerte. Er moet staan: Klik hier. Zodra je er op klikt, opent deze hyperlink de juiste .pdf. Iemand hier een oplossing voor?
* In de "Offertelijst" wil ik ook een link naar de bijbehorende calculatie in de map Calculaties.

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer 

'Create an instance of the FileSystemObject 
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object 
Set objFolder = objFSO.GetFolder("D:\Calculatie\Offertes")
i = 1
'loops through each file in the directory and prints their names and path 
For Each objFile In objFolder.Files
    'print file name 
    Cells(i + 1, 1) = objFile.Name 
    'print file path 
    Cells(i + 1, 2) = objFile.Path 
    i = i + 1 
Next objFile
End Sub

Zou fijn zijn als jullie me hiermee kunnen helpen!

 

[wampier]

Het FileSystemObject ondersteund ook 'GetBaseName' ipv 'name'. Je krijgt dan de naam van de file minus extensie.

Om een bewerking te doen op een bepaalde sheet kun je die toevoegen in het commando of WITH gebruiken. Ik heb helaas even geen excel beschikbaar. maar dat wordt zoiets:

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer 

'Create an instance of the FileSystemObject 
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object 
Set objFolder = objFSO.GetFolder("D:\Calculatie\Offertes")
i = 1
'loops through each file in the directory and prints their names and path
with sheets('offertelijst')
.UsedRange.Clear
For Each objFile In objFolder.Files
    'print file name 
    .Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path 
    .Cells(i + 1, 2) = objFile.Path 
    i = i + 1 
Next objFile
end with
End Sub

Mogelijk hier en daar een typotje. het toevoegen van de files kan met hyperlink.add maar ik als ik je vraag letterlijk lees krijg je alleen een lijst met "klik hier" ik neem aan dat je de hyperlink in een volgende cel toegevoegd wil hebben?

 

[Quiby]

Hallo Frank,

Kan je hier wat mee?

* Ik heb 8 verschillende calculatie tabbladen. Als ik op een tabblad voor een bepaald product een calculatie heb gemaakt, klik ik op een knop dat de calculatie wordt opgeslagen en een offerte sheet. Wel allebei in verschillende mappen.
De offerte komt in de map Offertes, de calculatie komt in de map Calculaties. Beide bestanden worden weggeschreven onder het offertenummer, geen probleem. Maar de lijst met offertes is een ander tabblad genaamd "Offertelijst".
De "Opslaan knop zit dus op 8 verschillende tabbladen, maar als ik daar op klik, moet het tabblad "Offertelijst" ook vernieuwd worden zodat daar de nieuwe offerte ook bij komt te staan. Is dit mogelijk? Zo ja, hoe?
Als ik het goed begrijp zijn er 2 lijsten een offerte en calculatie lijst. Deze wil je updaten op het moment dat er een nieuwe offerte of calculatie wordt aangemaakt? Is het een oplossing om de lijsten niet te updaten wanneer er een nieuwe calculatie of offerte wordt aangemaakt, maar de lijsten te updaten wanneer de lijst wordt geopend.

* Met onderstaande code wordt ook de extensie (.pdf in mijn geval) weergegeven. I.v.m. volg nummers moet alleen de bestandsnaam weergegeven worden zonder extensie. Hoe fix ik dat?
Dit zit nu in de macro verwerkt (zie hieronder)

* Het path dat weergegeven wordt, moet een hyperlink worden naar de offerte. Er moet staan: Klik hier. Zodra je er op klikt, opent deze hyperlink de juiste .pdf. Iemand hier een oplossing voor?
Dit zit nu in de macro verwerkt met behulp van het antwoord van Wampier in #8 (zie hieronder)


* In de "Offertelijst" wil ik ook een link naar de bijbehorende calculatie in de map Calculaties.
De offertes en de calculaties staan in verschillende mappen, maar hebben wel dezelfde naam toch? Dit zit nu ook in de macro.


Dit zou dan de code zijn. vergeet niet de rode gedeelten aan te passen

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("[COLOR="#FF0000"]C:\Users\Desktop\Nieuwe map[/COLOR]") 'locatie van de offertes
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 1, 2) = objFile.Path
    'hyperlink naar offerte
    Cells(i + 1, 3) = "=HYPERLINK(RC[-1],""Klik hier voor de offerte"")"
    'file calculatie
    PadMap = ("[COLOR="#FF0000"]C:\Users\MWTS\Desktop\Nieuwe map(2)[/COLOR]") 'locatie van de calculaties
    Cells(i + 1, 4) = PadMap & "\" & objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5) = "=HYPERLINK(RC[-1],""Klik hier voor de calculatie"")"
    i = i + 1
Next objFile
End Sub

 

[Soppuh]

Hallo Frank,

Kan je hier wat mee?

* Ik heb 8 verschillende calculatie tabbladen. Als ik op een tabblad voor een bepaald product een calculatie heb gemaakt, klik ik op een knop dat de calculatie wordt opgeslagen en een offerte sheet. Wel allebei in verschillende mappen.
De offerte komt in de map Offertes, de calculatie komt in de map Calculaties. Beide bestanden worden weggeschreven onder het offertenummer, geen probleem. Maar de lijst met offertes is een ander tabblad genaamd "Offertelijst".
De "Opslaan knop zit dus op 8 verschillende tabbladen, maar als ik daar op klik, moet het tabblad "Offertelijst" ook vernieuwd worden zodat daar de nieuwe offerte ook bij komt te staan. Is dit mogelijk? Zo ja, hoe?
Als ik het goed begrijp zijn er 2 lijsten een offerte en calculatie lijst. Deze wil je updaten op het moment dat er een nieuwe offerte of calculatie wordt aangemaakt? Is het een oplossing om de lijsten niet te updaten wanneer er een nieuwe calculatie of offerte wordt aangemaakt, maar de lijsten te updaten wanneer de lijst wordt geopend.

* Met onderstaande code wordt ook de extensie (.pdf in mijn geval) weergegeven. I.v.m. volg nummers moet alleen de bestandsnaam weergegeven worden zonder extensie. Hoe fix ik dat?
Dit zit nu in de macro verwerkt (zie hieronder)

* Het path dat weergegeven wordt, moet een hyperlink worden naar de offerte. Er moet staan: Klik hier. Zodra je er op klikt, opent deze hyperlink de juiste .pdf. Iemand hier een oplossing voor?
Dit zit nu in de macro verwerkt met behulp van het antwoord van Wampier in #8 (zie hieronder)


* In de "Offertelijst" wil ik ook een link naar de bijbehorende calculatie in de map Calculaties.
De offertes en de calculaties staan in verschillende mappen, maar hebben wel dezelfde naam toch? Dit zit nu ook in de macro.


Dit zou dan de code zijn. vergeet niet de rode gedeelten aan te passen

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("[COLOR="#FF0000"]C:\Users\Desktop\Nieuwe map[/COLOR]") 'locatie van de offertes
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 1, 2) = objFile.Path
    'hyperlink naar offerte
    Cells(i + 1, 3) = "=HYPERLINK(RC[-1],""Klik hier voor de offerte"")"
    'file calculatie
    PadMap = ("[COLOR="#FF0000"]C:\Users\MWTS\Desktop\Nieuwe map(2)[/COLOR]") 'locatie van de calculaties
    Cells(i + 1, 4) = PadMap & "\" & objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5) = "=HYPERLINK(RC[-1],""Klik hier voor de calculatie"")"
    i = i + 1
Next objFile
End Sub

Ik heb deze code aan een knop "vernieuw" geplakt om even te testen. Echter haalt hij de gegevens niet op.
Kan het komen omdat er misschien niet verwezen wordt naar het tabblad "Offertelijst" waar de gegevens in moeten komen te staan?

 

[Quiby]

De macro wordt uitgevoerd op het huidige tabblad, de knop zou je dan ook op het tabblad offertelijst moeten zetten. Als je de knop op een ander tabblad neer zet dit stukje nog even aan het begin van de code zetten

sheets("Offertelijst").select

Heb je verder rode tekst gewijzigd naar de mappen waar de calculaties en offertes staan?

 

[VenA]

Zitten jullie in de handel voor scrollwieltjes?

Zonder alles bekeken te hebben.

With sheets("Offertelijst")
'beetje veel code
end with

 

[Soppuh]

De macro wordt uitgevoerd op het huidige tabblad, de knop zou je dan ook op het tabblad offertelijst moeten zetten. Als je de knop op een ander tabblad neer zet dit stukje nog even aan het begin van de code zetten

sheets("Offertelijst").select

Heb je verder rode tekst gewijzigd naar de mappen waar de calculaties en offertes staan?

Rode tekst gewijzigd en de code toegevoegd. Het werkt! Laatste vraag. Ik wil alleen de bestandsnaam zien, zonder path en document extensie. Wat moet ik aanpassen?
EDIT: De link moet natuurlijk wel blijven werken.

 

[Quiby]

Alleen de bestandsnaam zoals in kolom A staat?

Misschien wanneer ik wat uit leg dat je hier zelf mee kan spelen
in het blauwe gedeelte van de code staat wat er er in de verschillende cellen ingevoerd dienen te worden.
Hierbij staat Cells(i + 1, 1) voor de betreffende cel. het rode gedeelte is de rij (dit hoeft niet aangepast te worden, het groene gedeelte is het kolom nummer ( 1=a, 2=b etc..)
Zo wordt er voor kolom 1 t/m 5 wat ingevoerd per rij en kan je zelf een beetje spelen met wat waar ingevoerd dient te worden.

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\Desktop\Nieuwe map") 'locatie van de offertes
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
[COLOR="#0000CD"]    Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 1, 2) = objFile.Path
    'hyperlink naar offerte
    Cells(i + 1, 3) = "=HYPERLINK(RC[-1],""Klik hier voor de offerte"")"
    'file calculatie
    PadMap = ("C:\Users\MWTS\Desktop\Nieuwe map(2)") 'locatie van de calculaties
    Cells(i + 1, 4) = PadMap & "\" & objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5) = "=HYPERLINK(RC[-1],""Klik hier voor de calculatie"")"
    i = i + 1[/COLOR]
Next objFile
End Sub

Kan je hier mee verder?

 

[Soppuh]

Hi Quiby,

Dat gedeelte snap ik. Alleen is in mijn geval zo, dat ik het laatste offertenummer uit de offerte kolom gebruik om het volgende nieuwe offertenummer aan te maken (laatste offertenummer in kolom B +1).
Dit werkt dus niet zolang er .pdf achter de bestandsnaam staat. Met onderstaande code heb ik de Path al weg gekregen, echter staat de extensie nog wel achter het nummer, die moet dus weg.
En de hyperlinks "klik hier" werken niet, omdat de verwijzing naar Path weg gehaald is. Ik weet niet hoe ik die hyperlink verwijzing in het stukje =hyperlink(RC[-] etc. moet toevoegen en uiteindelijk moet in de hyperlink wel weer de extensie er bij.

Zo komt het nu te staan met onderstaande code:

Offertenummer Offerte Calculatienummer Calculatie
20160001.pdf Klik hier 20160001.pdf Klik hier

.pdf moet dus weg, en de link moet wel werkend blijven.

Hoop dat ik niet te onduidelijk ben.

Sub Vernieuw()
Sheets("Offertelijst").Select

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("M:\Calculatie\Nieuw\Offertes") 'locatie van de offertes
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 2, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 2, 2) = objFile.Name
    'hyperlink naar offerte
    Cells(i + 2, 3) = "=HYPERLINK(RC[-1],""Klik hier"")"
    'file calculatie
    PadMap = ("M:\Calculatie\Nieuw\Calculaties") 'locatie van de calculaties
    Cells(i + 2, 4) = objFile.Name
    'hyperlink calculatie
    Cells(i + 2, 5) = "=HYPERLINK(RC[-1],""Klik hier"")"
    i = i + 1
Next objFile
End Sub

 

[Quiby]

Sub Vernieuw()
Sheets("Offertelijst").Select

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("M:\Calculatie\Nieuw\Offertes") 'locatie van de offertes
   PadMap = ("M:\Calculatie\Nieuw\Calculaties") 'locatie van de calculaties
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 2, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 2, 2) = objFile.Name
    'hyperlink naar offerte
    Cells(i + 1, 3).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:="Klik hier"
    'file calculatie
    Cells(i + 2, 4) = objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PadMap, TextToDisplay:="Klik hier"
    i = i + 1
Next objFile
End Sub

Ik heb hem iets aangepast.
Ik krijg nu in de volgende kolommen
Kolom A: Bestandnaam zonder extentie
Kolom B: Bestandsnaam met extentie
Kolom C: Hyperlink naar offerte met de tekst "Klik hier"
Kolom B: Bestandsnaam met extentie
Kolom C: Hyperlink naar calculatie met de tekst "Klik hier"

Ik zie in kolom A dus het bestand zonder de extentie. Begrijp ik je goed, als dat niet het geval is kan je dan eens een print screen toevoegen?

 

[Soppuh]

Sub Vernieuw()
Sheets("Offertelijst").Select

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("M:\Calculatie\Nieuw\Offertes") 'locatie van de offertes
   PadMap = ("M:\Calculatie\Nieuw\Calculaties") 'locatie van de calculaties
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 2, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 2, 2) = objFile.Name
    'hyperlink naar offerte
    Cells(i + 1, 3).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:="Klik hier"
    'file calculatie
    Cells(i + 2, 4) = objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PadMap, TextToDisplay:="Klik hier"
    i = i + 1
Next objFile
End Sub

Ik heb hem iets aangepast.
Ik krijg nu in de volgende kolommen
Kolom A: Bestandnaam zonder extentie
Kolom B: Bestandsnaam met extentie
Kolom C: Hyperlink naar offerte met de tekst "Klik hier"
Kolom B: Bestandsnaam met extentie
Kolom C: Hyperlink naar calculatie met de tekst "Klik hier"

Ik zie in kolom A dus het bestand zonder de extentie. Begrijp ik je goed, als dat niet het geval is kan je dan eens een print screen toevoegen?

Yes, Dankje! Dit komt aardig in de buurt. Echter, als ik nu op de link klik van de calculaties, opent hij de map calculaties en niet het desbetreffende calculatie document.

 

[Quiby]

Foutje had inderdaad voor de calculatie niet helemaal juist aangepast.

Sub Vernieuw()
Sheets("Offertelijst").Select

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("M:\Calculatie\Nieuw\Offertes") 'locatie van de offertes
   PadMap = ("M:\Calculatie\Nieuw\Calculaties") 'locatie van de calculaties
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 1, 2) = objFile.Name
    'hyperlink naar offerte
    Cells(i + 1, 3).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:="Klik hier"
    'file calculatie
    Cells(i + 1, 4) = objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PadMap & "\" & objFile.Name, TextToDisplay:="Klik hier"
    i = i + 1
Next objFile
End Sub

 

[Soppuh]

Foutje had inderdaad voor de calculatie niet helemaal juist aangepast.

Sub Vernieuw()
Sheets("Offertelijst").Select

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("M:\Calculatie\Nieuw\Offertes") 'locatie van de offertes
   PadMap = ("M:\Calculatie\Nieuw\Calculaties") 'locatie van de calculaties
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 1) = objFSO.GetBaseName(objFile)
    'print file path
    Cells(i + 1, 2) = objFile.Name
    'hyperlink naar offerte
    Cells(i + 1, 3).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:="Klik hier"
    'file calculatie
    Cells(i + 1, 4) = objFile.Name
    'hyperlink calculatie
    Cells(i + 1, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=PadMap & "\" & objFile.Name, TextToDisplay:="Klik hier"
    i = i + 1
Next objFile
End Sub

Mijn held! Super bedankt!!!