[VBA] Excel bestand opslaan

[M.v.Veelen]

Hoi,

ik gebruik onderstaande code om mailtjes te versturen met attachment.

Alleen komt soms de bestandsnaam al voor en krijg ik een foutmelding. Hoe kan ik ervoor zorgen dat ALS de bestandsnaam al bestaat, dit zonder foutmelding wordt ondervangen door bijvoorbeeld een opvolgend nummer erachter te laten plakken ? Het kan dus ook zijn dat er bestand.xls én bestand(1).xls staat, er zou dan bestand(2).xls van gemaakt moeten worden ofzo (automatisch).

Heeft iemand hier een ideetje voor ?

code:

Sub auto_opslaan()
    Fname = Sheets("Aanmeldings Formulier").Range("B25").Value & ".xls"
    Melding = Sheets("Aanmeldings Formulier").Range("G4").Value
    
    ChDir "H:\padnaamL\Aangemelde storingen\"
    ActiveWorkbook.SaveAs Filename:="H:\padnaam\Aangemelde storingen\" & Fname
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "[e-mail]"
        .CC = ""
        .BCC = ""
        .Subject = "Melding : " & Melding
        .Body = "Ls." & vbCrLf & vbCrLf & "Gaarne in behandeling nemen." & vbCrLf & vbCrLf & "Met vriendelijke groet," & vbCrLf & vbCrLf & "Pietje Puk" & vbCrLf & "Tel. [phone]" & vbCrLf & "Bedrijfsnaam" & vbCrLf & vbCrLf
        .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add (Fname)
        .Display   'of gebruik .Send als het meteen verzonden kan worden
    End With
    On Error GoTo 0
     Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[ATS]

OK, de crux van je probleem zit in dit stukje denk ik:

code:

    Fname = Sheets("Aanmeldings Formulier").Range("B25").Value & ".xls"
    Melding = Sheets("Aanmeldings Formulier").Range("G4").Value
    
    ChDir "H:\padnaamL\Aangemelde storingen\"
    ActiveWorkbook.SaveAs Filename:="H:\padnaam\Aangemelde storingen\" & Fname

Wat je doet is het controleren van het al dan niet bestaan van de bestandsnaam die je op het oog hebt. Zoeken met Google op "VBA file exists" geeft je een aardige collectie van mogelijkheden (inclusief kant en klare functies) om dat te doen.

Wat je vervolgens doet is een loopje maken (pseudo code):

code:

Dim append as Integer
fileName = path + basisnaam + extention
append = 0
While (fileExists(fileName))
    append = append + 1
    fileName = path + basisnaam + "(" + append + ")" + extention
Wend
//Doe iets met de nu gevonden, nog niet bestaande naam.

Algemene opmerking: waarom verstuur je email vanuit een functie die "auto_opslaan" heet? Dat klinkt niet als een logische invulling van die functie...

[M.v.Veelen]

ATS schreef op maandag 10 december 2007 @ 18:26:
Algemene opmerking: waarom verstuur je email vanuit een functie die "auto_opslaan" heet? Dat klinkt niet als een logische invulling van die functie...

Komt omdat ik dmv. één druk op de knop het bestand op laat slaan en meteen het betreffende bestand als attachment in Outlook toevoeg om te verzenden. Bovendien ben ik hiertoe gekomen door wat te knippen en plakken vanuit reeds bestaande scriptjes.

[urk_forever]

Bekijk de dir functie van vb(a) eens. Die geeft een lege string terug als het bestand niet bestaat, anders bestaat het wel. Dan krijg je dit bijvoorbeeld:

Visual Basic 6:

  Dim strFile As String
  strFile = "Test"
  
  While Dir("C:\" & strFile & ".xml") <> ""
    strFile = strFile & "1"
  Wend

[Bolukan]

Je kunt ook de timestamp toevoegen aan de bestandsnaam.

[Creepy]

VBA? Excel? Dat klinkt als een mooi topic voor Officesuites en -software. Lees aub Waar hoort mijn topic? eens door zodat je weet waar welk topic hoort.

Move PRG -> OFF

[ Voor 4% gewijzigd door Creepy op 11-12-2007 09:54 ]

[M.v.Veelen]

Ik heb nu :

code:

Function FileThere(FileName As String) As Boolean
     FileThere = (Dir(FileName) > "")
End Function

Sub auto_opslaan()
    Fname = Sheets("Aanmeldings Formulier").Range("B25").Value & ".xls"
    Melding = Sheets("Aanmeldings Formulier").Range("G4").Value
    
    ChDir "H:\padnaam\Aangemelde storingen\"

 
If FileThere("H:\padnaam\Aangemelde storingen\" & Fname) Then

MsgBox "Bestandsnaam bestaat al, aub. het oude bestand eerst renamen!"

Else

    ActiveWorkbook.SaveAs Filename:="H:\padnaam\Aangemelde storingen\" & Fname
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "[e-mail]"
        .CC = ""
        .BCC = ""
        .Subject = "Melding : " & Melding
        .Body = "Ls." & vbCrLf & vbCrLf & "Gaarne in behandeling nemen." & vbCrLf & vbCrLf & "Met vriendelijke groet," & vbCrLf & vbCrLf & "Pietje Puk" & vbCrLf & "Tel. [phone]" & vbCrLf & "Bedrijfsnaam" & vbCrLf & vbCrLf
        .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add (Fname)
        .Display   'of gebruik .Send als het meteen verzonden kan worden
    End With
    On Error GoTo 0
     Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

En ik krijg nu geen akelige foutmelding meer als het bestand al bestaat en dus keurig de melding die hierboven is ingevuld. Alleen wil ik dát dus veranderd hebben zodat ie het bestand herkent/uitleest en daar dan dus een (1) achteraan plakt.

Ben druk aan het knippen en plakken maar kom er nog even neit uit.

Als iemand mij nóg een zetje kan geven ?

[F_J_K]

Je hebt de IF..THEN al, nu is het simpelweg de statement na THEN.. aanpassen, zodanig dat de Fname string wordt aangepast. Overigens wil je dat niet een keer doen, maar in een WHILE loopje. Dus
i = 0
WHILE FileThere(..Fname..)
i = i + 1
Fname = Fname + i
WEND
En nu opslaan als Fname

Bovenstaande is natuurlijk geen echte code.

[M.v.Veelen]

Weet jij hoe ik dit in de bestaande code kan zetten ?

[F_J_K]

Hoe bedoel je, waar loop je vast? Ik neem aan dat je weet (of hebt opgezocht) hoe loopjes werken en hoe je ene getal kunt toevoegen aan een string. Zo niet:

i = 1
Fname = "fiets"
Fname = Fname & i
MsgBox Fname

==> fiets1

[urk_forever]

Zoiets zou moeten werken, alhoewel je dit zelf ook wel zou moeten kunnen bedenken.

Visual Basic 6:

Function FileThere(FileName As String) As Boolean
     FileThere = (Dir(FileName) > "")
End Function

Sub auto_opslaan()
Dim i as integer
  
  i = 1

    Fname = Sheets("Aanmeldings Formulier").Range("B25").Value
    Melding = Sheets("Aanmeldings Formulier").Range("G4").Value
    
    ChDir "H:\padnaam\Aangemelde storingen\"

while FileThere("H:\padnaam\Aangemelde storingen\" & Fname & ".xls")
  FName = FName & i
wend

  fName = Fname & ".xls"

    ActiveWorkbook.SaveAs Filename:="H:\padnaam\Aangemelde storingen\" & Fname
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "[e-mail]"
        .CC = ""
        .BCC = ""
        .Subject = "Melding : " & Melding
        .Body = "Ls." & vbCrLf & vbCrLf & "Gaarne in behandeling nemen." & vbCrLf & vbCrLf & "Met vriendelijke groet," & vbCrLf & vbCrLf & "Pietje Puk" & vbCrLf & "Tel. [phone]" & vbCrLf & "Bedrijfsnaam" & vbCrLf & vbCrLf
        .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add (Fname)
        .Display   'of gebruik .Send als het meteen verzonden kan worden
    End With
    On Error GoTo 0
     Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[ Voor 0% gewijzigd door urk_forever op 11-12-2007 11:59 . Reden: Extensie aangepast ]

[M.v.Veelen]

Ik zit er gewoon héél dicht bij (denk ik).......

Maar krijg het in de bestaande code gewoon niet ingebouwd

Met bovenstaande (zoiets was ik dus mee aan het proberen) slaat hij een bestand op : test.xls, vervolgens verwacht je dat hij deze herkent en er bij een volgende poging test1.xls van maakt. Dat doet hij niet, hij komt met de melding dat hij al bestaat en de foutopsporing kan gaan beginnen.....

[ Voor 56% gewijzigd door M.v.Veelen op 11-12-2007 12:03 ]

[urk_forever]

Dan moet je even aangeven wat er niet werkt.

[M.v.Veelen]

Hij stop dus met de melding dat het bestand al bestaat en in de foutopsporing staat dan de regel :

H:\Diensten en processen\ADSL\Aangemelde storingen\ in het geel......dit omdat hij probeert een bestand op te slaan die al bestaat.

Ik heb hier ook wat gevonden, maar zou écht niet weten hoe ik dit in mijn bestaande scriptje kan inbouwen :

http://www.webbedwonder.c...ages/Unique-File-Name.asp

Ik weet dat het niet de bedoeling is om een kant-en-klare oplossing aan te dragen en mensen zelf te laten nadenken / zwoegen, maar ik draai rond in een cirkeltje. Als er iemand is die me nog een zetje kan en wil geven : heel graag.

[ Voor 47% gewijzigd door M.v.Veelen op 11-12-2007 12:28 ]

[F_J_K]

En dan ga je dus debuggen, bijv. door in elke 'verdachte' stap met debug.print of evt. een msgbox de relevante waarden weer te geven en dan bedenken waar het fout gaat (en ons evt er bij betrekken door aan te geven wat de situatie precies is).

Het punt is: ga niet copypasten van deze of een andere site. Ga interpreteren, nadenken en uitzoeken hoe het zou moeten werken. Anders kom je er nooit, of als het wel werkt is het gammel/slecht onderhoudbaar en dan loop je later stuk

Edit:

code:

Function FileThere(FileName As String) As Boolean
     FileThere = (Dir(FileName) > "")
End Function
Sub foo()

  Dim i As Integer
  i = 1
  
  Fname = Sheets("Blad1").Range("A1").Value
  While FileThere("C:\temp\" & Fname & ".xls")
    Fname = Fname & i
  Wend
  Fname = Fname & ".xls"
  ActiveWorkbook.SaveAs FileName:="C:\temp\" & Fname

End Sub

Werkt namelijk prima.

Overigens heb je nu natuurlijk filenames zoals c:\temp\foo11111111.xls etc, dus voor het mooie wil je de i pas na de loop in de Fname wegschrijven.

[ Voor 36% gewijzigd door F_J_K op 11-12-2007 12:44 ]

[M.v.Veelen]

Inderdaad, dit werkt prima zo, bedankt !

Alleen dat laatste begrijp ik niet zo en krijg ik ook niet aan de praat.

Het wordt nu iig zoiets :

bestand.xls
bestand1.xls
bestand11.xls
bestand111.xls
enz.

Werkt ook prima

[ATS]

En dat terwijl er al in mijn eerste antwoord een voorbeeld van een werkende loop stond om een mooie bestandsnaam te maken...

[M.v.Veelen]

ATS schreef op dinsdag 11 december 2007 @ 13:50:
En dat terwijl er al in mijn eerste antwoord een voorbeeld van een werkende loop stond om een mooie bestandsnaam te maken...

Ehm, dan heb ik die verkeerd gebruikt, dat ligt iig meer voor de hand dan dat jij het fout hebt uitgelegd