Excel file kopie opslaan als een nieuwe file

[kaan]

Hallo allemaal,

Ik heb een oude excel file met een verouderde module.

Ik wil deze module aanpassen en omzetten naar Excel 2010.
Kan iemand mij hiermee helpen?

Alvast bedankt.

Sub Maakkopie()

Application.EnableCancelKey = xlDisabled

Dim i As Integer, Aantal As Integer
Dim j As Integer
Dim k As Integer
Dim s As String, map2 As String
Dim b As String, Jaar As String
Dim Jaar2 As String
Dim Titel As String, Map As String, Gehelenaam As String
Dim Welboek As Boolean

ActiveWorkbook.save

Welboek = False
Application.DisplayAlerts = False
Titel = "Indeling" & _
        Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 14)
Pad = "H:\INDELING_orijineel\" & Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 16) & _
 Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 16) & "\" & Titel

j = 1
i = 1

map2 = Titel & ".xls"
For i = 1 To Aantal

  If Workbooks(i).Name = map2 Then
     Workbooks(i).Close

  End If
Next i


b = "H:\INDELING_orijineel\" & Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 10)
If PathExists(b) Then
    Jaar = Sheets(1).Cells(1, 10)
    b = "H:\INDELING_orijineel\" & Jaar
Else
    ' Make a Dir
    Jaar = Sheets(1).Cells(1, 10)
    b = "H:\INDELING_orijineel\" & Jaar
    MkDir b
End If

s = "H:\INDELING_orijineel\" & Jaar & "\" & Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 15) & _
Workbooks("INDELING_FILE.xls").Sheets(1).Cells(1, 16)
Gehelenaam = s & "\" & Titel
If PathExists(s) Then
    Map = Sheets(1).Cells(1, 16)
    Jaar = Sheets(1).Cells(1, 10)
'    MsgBox "map=" & map & "Er is een pad"
    s = "H:\INDELING_orijineel\" & Jaar & "\" & Map & "\" & Titel
    Workbooks("INDELING_FILE.xls").SaveAs Filename:=Gehelenaam
Else

    ' Make a Dir
    Map = Sheets(1).Cells(1, 16)
    Jaar = Sheets(1).Cells(1, 10)
    s = "H:\INDELING_orijineel\" & Jaar & "\" & Map & ""
    MkDir s
    s = "H:\INDELING_orijineel\" & Jaar & "\" & Map & "\" & Titel
    Workbooks("INDELING_FILE.xls").SaveAs Filename:=s
  Workbooks.Open ("H:\INDELING_orijineel\INDELING_FILE.xls")
End If

Aantal = Workbooks.Count
map2 = Titel & ".xls"
For i = 1 To Aantal

  If Workbooks(i).Name = map2 Then
  Workbooks.Open ("H:\INDELING_orijineel\INDELING_FILE.xls")
'  Workbooks.Open ("H:\INDELING_orijineel\" & Jaar & "\" & Map & "\\" & Titel & ".xls")
 ' Workbooks(i).Close


  End If
Next i
 Workbooks("H:\INDELING_orijineel\INDELING_FILE.xls").Activate

End Sub


Function PathExists(pname) As Boolean
On Error Resume Next
PathExists = (GetAttr(pname) And vbDirectory)
End Function

Function FileExists(fname) As Boolean
    FileExists = Dir(fname) <> ""
End Function

 

[edmoor]

Zo op het eerste snelle gezicht hoef je alleen maar .xls te vervangen door .xlsx en dan bij de SaveAs het type bestand op te geven. B.v.:

Oud:

Workbooks("INDELING_FILE.xls").SaveAs Filename:=Gehelenaam

Nieuw:

Workbooks("INDELING_FILE.xlsx").SaveAs Filename:=Gehelenaam, FileFormat:=xlOpenXMLWorkbook

Dit is een lijstje van bestandstypen die je kunt gebruiken:
51 = xlOpenXMLWorkbook (zonder macro's in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (met of zonder macro's in 2007-2013, xlsm)
50 = xlExcel12 (Excel Binair Werkboek in 2007-2013 met of zonder macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)

Mocht je willen opslaan als PDF dan gebruik je FileFormat:=0

 

[kaan]

Goedenavond Edmoor,

Als eerste wil ik je bedanken voor je antwoord.
Ik heb de file als bijlage toegevoegd zodat je het kan testen.

Als ik de regel aanpas zoals je het hierboven noemde krijg ik op die regen een fout melding!
Als ik het weer naar de originele aanpast werkt de module wel maar dan krijg ik weer een error melding op de regel: Workbooks("C:\excel\INDELING.xlsm").Activate
Kun je het testen?
Groet, Kaan

 

[edmoor]

Voordat ik dat ga doen wil ik graag weten welke foutmeldingen je krijgt.

 

[kaan]

Goedemorgen,

Ik heb het regel verandert naar

Workbooks("INDELING_FILE.xlsx").SaveAs Filename:=Gehelenaam, FileFormat:=xlOpenXMLWorkbook

en alle xls aangepast naar xlsx, helaas krijg ik een fout melding.

Melding is:

Run-time error '9':
Subscript out of range

Wat doe ik fout?

 

[edmoor]

Dat staat los van die verandering. Maak even een voorbeeld documentje waar dat in gebeurd en plaasts deze hier. Dan kan ik wel even kijken wat er aan de hand is.

 

[kaan]

Ok,

Hier is een voorbeeld:

 

[edmoor]

Je verwijst in de code nog naar INDELING.xlsx en dat moet INDELING.xlsm zijn. Had dus toch met de verandering te maken

 

[kaan]

Okay, dat ook aangepast en het werkt.

Nu een vraag ivm fine tuning:

Er word een nieuwe file aangemaakt aan de hand van naam en datum.
Het zal erg handig zijn dat deze files hierna worden afgesploten!

Hoe kan ik dat doen?

Een ook een andere probleem:

Als de file al bestaat krijg ik een error melding, wat is eigenlijk handig dit zo laten?


Kaan

 

[edmoor]

Als je zegt een foutmelding te krijgen laat hier dan ook even weten welke dat is.

 

[kaan]

Sorry, je heb helemaal gelijk. Ik dacht dat ik wel een foto toegevoegd had maar ik zie dat ik het vergeten ben.

 

[kaan]

Ik zal volgeden regel kunnen gebruiken om de nieuw aangemaakte file te kunnen sluiten maar waar zet ik deze regel neer?

activeworkbook.close true