oprette filer automatisk ud fra en liste og en skabelon

Det kan nok lade sig gøre- men der er noget, der skal præciseres:
- Skal knappen gælde alle "kundenr" i kolonne B - eller kun den markerede?
- Skal der oprettes 2 filer: 2000v.xls og 2000.xls pr. kundenr?
- Hvis Ja skal de ligge i samme mappe?
- Skal der som standard oprettes særlig navgivne ark i mapper- eller blot standard?

Alle kundnumre.
dvs den skal egentlig gennemløbe listen og hvis der ikke findes en fil med dette navn i forvejen på den angivne sti, skal den oprette - i første omgang filen xxxxv.xls ud fra skabelon.xlt.

Ja to filer. en xxxxv.xls efter skabelon.xlt
den anden blot en tom fil xxxx.xls

Nej v=versionsdelen skal ligge i samme mappe som skabelonen, Dvs instruktioner\version\xxxxv.xls og de tomme filer i instruktioner\xxxx.xls

Skabelonen liger i instruktioner\version\xxxx.xlt

Øh det sidste forstod jeg ikke?

LN

OK - det sidste - det var nok fordi "skabelonen" ikke var med...

Et forslag:

Const vSti = "C:\instruktioner\version\"          'Tilpasses
Const tSti = "C:\instruktioner\"                  'Tilpasses
Dim kNrRæk, knr
Sub knap()  '<-------- simulering af knap
Rem find række for sidste kundenr
    kNrRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Test kolonne B for kundeNr
    For ræk = 3 To kNrRæk
        knr = Cells(ræk, 2)
        If erFilerOprettet(knr) = False Then
            opretFiler knr
        End If
    Next ræk
End Sub
Private Function erFilerOprettet(knr)
Dim fs, f, f1, fc, s

Rem Søg efter versions-fil
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(vSti)
    Set fc = f.Files
    For Each f1 In fc
        If InStr(f1.Name, CStr(knr)) Then
            erFilerOprettet = True
            Exit Function
        End If
    Next
    erFilerOprettet = False
End Function
Private Sub opretFiler(knr)
Dim xls
    Set xls = CreateObject("Excel.application")
    With xls
        .Workbooks.Open Filename:=vSti + "Skabelon.xlt"
        .ActiveWorkbook.SaveAs vSti + CStr(knr) + "v.xls"
   
        .Workbooks.Add
        .ActiveWorkbook.SaveAs tSti + CStr(knr) + ".xls"
       
    End With
    Set xls = Nothing
End Sub

Hej egntlig virker det fint men det er som om filerne "hænger"

Dvs går jeg efterfølgende ind og feks åbner 2034v.xls, får jeg en besked om at 2034v.xls er i brug af mig og skrivebeskyttet. Lukker den så ned og hele excel. Alligevel sker det samme igen. desuden åbnes ikke kun denne fil men en to tre filer feks 2034v,20034 og 2004. Laver jeg så i feks 10 min noget andet og prøver igen ja så går det fint. Virker meget mystisk. Prøvede kun lige med 3-4 kundenumre.

Er det egentlig muligt med det samme at få nogle værdier med over på kundearkene.
I kolonne B står kundenumrene, og i c står feks det tilsvarende kundenavn og i d det koncept de kører efter. Kan man feks hive disse dat med over med det samme til forskellige felter i kunde filerne. Eks kundenummer til c3, kundenavn i B8, koncept til C10.

PS hvad gør den sidste linie Set xls = Nothing ??

LN

PS: Det sidste først - frigiver objektet

Prøver at finde en løsning på det øvrige...

Vedr. At få flere data med over - ja - vender tilbage - tirsdag..

Vedr. "låsning" - her er version 2:

Rem Version 2
Rem =========
Const vSti = "C:\instruktioner\version\"
Const tSti = "C:\instruktioner\"
Dim kNrRæk, knr
Sub knap()
Rem find række for sidste kundenr
    kNrRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Test kolonne B for kundeNr
    For ræk = 3 To kNrRæk
        knr = Cells(ræk, 2)
        If erFilerOprettet(knr) = False Then
            opretFiler knr
        End If
    Next ræk
End Sub
Private Function erFilerOprettet(knr)
Dim fs, f, f1, fc, s

Rem Søg efter versions-fil
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(vSti)
    Set fc = f.Files
    For Each f1 In fc
        If InStr(f1.Name, CStr(knr)) Then
            erFilerOprettet = True
            Exit Function
        End If
    Next
    erFilerOprettet = False
End Function
Private Sub opretFiler(knr)
Dim xls
    Set xls = CreateObject("Excel.application")
    With xls
        .Visible = False
        .Workbooks.Open Filename:=vSti + "Skabelon.xlt"
        .ActiveWorkbook.SaveAs vSti + CStr(knr) + "v.xls"
        .ActiveWorkbook.Close
        .Application.Quit
        Set xls = Nothing
    End With
   
    Workbooks.Add
    ActiveWorkbook.SaveAs tSti + CStr(knr) + ".xls"
    ActiveWorkbook.Close
End Sub

Ok det ser bedre ud nu.
Bortset fra at jeg har valgt at oprette filerne xxxx.xls fra en anden skabelon og ikke en tom skabelon.

Jeg har dog nogle datoer på min skabeloner som desværre bibeholdes. Bla redigeringsdato, Dvs der står den dato, hvor jeg sidst har redigeret skabelonen og ikke den dao filerne er oprettet(redigeret).

Har prøvet med 120 kunder og det tog ca 10 min. Dejligt.

LN
LN

hmmm mæekeligt nu låser min datafil i stedet. Har været nødt til at oprette en ny.

LN

den opfører sig virkelig mærkeligt nu har kaldt datafilen version.xls
Og jeg får at vide at den er åben og ikke kan redigeres. Den er ikke åben,

Jeg kopierede den så og omdøbte den nye til version1.xls. Når jeg så åbner den så åbner den også version.xls

Min kode ser således ud - på en knap

Rem Version 2
Rem =========
Const vSti = "\\sti\versionsstyring\"
Const tSti = "\\sti\"
Dim kNrRæk, knr
Sub knap()
Rem find række for sidste kundenr
    kNrRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Test kolonne B for kundeNr
    For ræk = 3 To kNrRæk
        knr = Cells(ræk, 2)
        If erFilerOprettet(knr) = False Then
            opretFiler knr
        End If
    Next ræk
End Sub
Private Function erFilerOprettet(knr)
Dim fs, f, f1, fc, s

Rem Søg efter versions-fil
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(vSti)
    Set fc = f.Files
    For Each f1 In fc
        If InStr(f1.Name, CStr(knr)) Then
            erFilerOprettet = True
            Exit Function
        End If
    Next
    erFilerOprettet = False
End Function
Private Sub opretFiler(knr)
Dim xls
    Set xls = CreateObject("Excel.application")
    With xls
        .Visible = False
        .Workbooks.Open Filename:=vSti + "Skabelon.xlt"
        .ActiveWorkbook.SaveAs vSti + CStr(knr) + "v.xls"
        .ActiveWorkbook.Close
        .Application.Quit
       
       
        'Workbooks.Add
    .Workbooks.Open Filename:=tSti + "Skabelon.xlt"
    .ActiveWorkbook.SaveAs tSti + CStr(knr) + ".xls"
    .ActiveWorkbook.Close
    Set xls = Nothing
    End With
   
   
End Sub

LN

Tror jeg har fundet synderen

Det er når jeg står på de enkelte filer og henter data vi koden

Const dataSti = "\\sti\"      'tilpasses
Const dataFilNavn = "version1.xls"                                  'tilpasses
Dim kNrRæk, knr
Sub knap()
Rem kundenr fra aktuellefil-navn
    knr = Left(ActiveWorkbook.Name, 4)
   
    hentFraDatafil Val(knr)
End Sub
Private Sub hentFraDatafil(knr)
Dim xls
    Set xls = CreateObject("Excel.application")
    With xls
        .Workbooks.Open Filename:=dataSti + dataFilNavn
        kNrRæk = .ActiveCell.SpecialCells(xlLastCell).Row
       
        For ræk = 3 To kNrRæk
            If knr = .Cells(ræk, 2) Then
                ActiveWorkbook.Sheets(1).Cells(3, 3) = .Cells(ræk, 2)
                ActiveWorkbook.Sheets(1).Cells(11, 3) = .Cells(ræk, 3)
                Set xls = Nothing
                Exit Sub
            End If
        Next ræk
    End With
    Set xls = Nothing
    MsgBox ("Kundenr. " + knr + " ikke fundet")
End Sub


Den låser i hvert fald også version1.xls

Kan du se havd det er der gør dette?

LN

ok det  gik i orden da jeg genstratede min maskine - men det er jo ikke løsningen ;O)

Mærkede du paniken helt over til dig?

LN

Ja - og efterhånden er det vil vanskeligt, at overskue situationen.
Hvad gør vi for at komme videre.....?

ja er der ikke noget i ovenstående kode der ligesom binder/holder på filen verion?

Kunne forestille mig det kunne være lidt af det samme der skete med koden der oprettede filer ud fra skabeloner - hvor de ligesom hang. Har prøvet at koble lidt af koderne sammen men det lykkes ikke helt.

Hmm ja jeg må fortsætte med at prøve mig lidt frem - gider du se på koden igen?
Jeg skal nok melde tilbage med det samme hvis jeg finder ud af noget.

Dumt spm igen. Hvad gør denne linie
Set xls = CreateObject("Excel.application")

LN

Ok - skal nok vende tilbage hertil.

"Set xls = CreateObject("Excel.application")" - opretter et objekt af typen Excel- d.v.s. at der kan arbejdes med objektet som et regneark.

Hej du må heller få lagt et svar

Mht at få nogle data med over med det samme er det muligt - og ja det gvier ekstra point

LN

Det gør jeg så....

;O)