Makro för att spara som .xlsx .docx

[Mikael63]

Dags igen! Denna gång önskar jag makro både för MS Excel och MS Word (MS365) där man sparar aktuell bok, som då är en .xls resp. doc, som .xlsx resp .docx med samma namn i samma sökväg. Önskvärt med felmeddelande om fil med det namnet redan finns.

(Jo, det är inte många klick för att välja "Spara som..." heller men..)

Redigerad Mars 18 av Mikael63

[MH_]

Har inte testat själv. men du kan väl kolla det här?

https://learn.microsoft.com/sv-se/office/vba/api/excel.workbook.fileformat

Konstanter:

https://learn.microsoft.com/en-us/office/vba/api/excel.xlfileformat

Vill du ha ett "vanligt" modernt excelformat så är du är alltså ute efter: xlOpenXMLWorkbook    51

Så i microsoftexemplet bör "save as" raden ändras till 

ActiveWorkbook.SaveAs fileFormat:=xlOpenXMLWorkbook

Och om du kollar konstant-sidan så är det en massa format som har ändelsen .XLS (16,27,29,33,39,39,56,43,-4143). Så för "IF-raden" måste du kolla hela gänget 

Sub PutinSugerOtvättadBjörnK()
Dim iX As Integer

iX = ActiveWorkbook.FileFormat

If (iX = 16) Or (iX = 27) Or (iX = 29) Or (iX = 33) Or (iX = 39) Or (iX = 39) Or (iX = 56) Or (iX = 43) Or (iX = -4143) Then
    ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook
End If
End Sub

 

Man borde kunna kolla filändelsen med "ActiveWorkbook.Name". Men Om du har dolt filändelser i utforskaren så skall VBA tydligen respektera det (av någon fullständigt obegriplig anledning).

[Mikael63]

Tack!

Funkade rakt av i Excel (behåller namnet på makrot!)

**

När jag kollar i Word och spelar in att jag sparar som Docx och sedan kollar https://learn.microsoft.com/en-us/office/vba/api/word.saveas2

ser jag att alla parametrar är Optional varför jag städat bort allt utom

ActiveDocument.SaveAs2 FileFormat:=wdFormatXMLDocument

Att endast köra den sparar filen i samma format, tydligen(?)

Villkor hämtar jag här:

https://learn.microsoft.com/en-us/office/vba/api/word.wdsaveformat

men

iX = ActiveDocument.FileFormat

funkar tydligen inte här och jag hittar inte motsvarande heller?

 

[Mikael63]

2 timmar sedan, MH_ sade:

Men Om du har dolt filändelser i utforskaren

Nej, aldrig!!

[MH_]

I word får du tydligen tag i dokumentets filformat genom "SaveFormat" (när man tänker efter är "wdsaveformat" en ganska tydlig ledtråd...)
iX = ActiveDocument.SaveFormat

Egentligen ganska logiskt att hämta ut egenskapen på det sättet, även om jag tycker att Excels variant är snällare mot hjärnan. Alla dokumentegenskaper man inte viste att man behövde:

https://learn.microsoft.com/sv-se/office/vba/api/word.document#properties

[Mikael63]

Det vill sig icke..

Sub PutinSugerOtvättadBjörnK()
Dim iX As Integer

iX = ActiveDocument.SaveFormat

If (iX = 0) Or (iX = 1) Or (iX = 2) Or (iX = 3) Or (iX = 4) Or (iX = 5) Or (iX = 6) Or (iX = 7) Or (iX = -4143) Then
    ActiveDocument.SaveAs2 FileFormat:=wdFormatXMLDocument
    
End If
End Sub

 

[Mikael63]

Från

https://learn.microsoft.com/sv-se/office/vba/api/word.saveas2

kan jag använda

Sub SaveAsTextFile() 
    Dim strDocName As String 
    Dim intPos As Integer 
 
    ' Find position of extension in file name 
    strDocName = ActiveDocument.Name 
    intPos = InStrRev(strDocName, ".") 
 
    If intPos = 0 Then 
 
        ' If the document has not yet been saved 
        ' Ask the user to provide a file name 
        strDocName = InputBox("Please enter the name " & _ 
            "of your document.") 
    Else 
 
        ' Strip off extension and add ".txt" extension 
        strDocName = Left(strDocName, intPos - 1) 
        strDocName = strDocName & ".txt" 
    End If 
 
    ' Save file with new extension 
    ActiveDocument.SaveAs2 FileName:=strDocName, _ 
        FileFormat:=wdFormatText 
End Sub

Jag kan även anpassa detta för att få till docx.

Filen sparas då i "Lokal filsökväg som standard"

 

[MH_]

Word-VBA är förvirrande...

[Mikael63]

Ja det får väl ändå betraktas som överkurs.

**

Tanken att spara som.../konvertera till nyare format är till en viss/liten del estetisk, att alla lika filtyper i en projektmapp ska ha lika filtillägg. (Nej det funkar inte att bara ändra filtillägget)

Den mer "riktiga" anledningen har en koppling till min tråd angående "Viewers". Där har jag backat från en mjukvara till att använda "Lister-plugin" i Total Commander. För xls & xlsx fungerar den okej oavsett filtyp. För docx fungerar också plugin bra. För doc finns, som det verkar ingen plugin som visar innehållet grafiskt (i mitt fall en tabell) utan bara texten. Detta är egentligen fullt tillräckligt, snabbtitten är bara för att se att det är rätt, eller fel, fil jag ska öppna (eller inte). Men eftersom jag nu har börja "dra i" detta så...

Det finns mjukvara som enkelt kan fixa en sådan konvertering från xls till xlsx, från doc till docx, och, om man vill även ta bort xls. Även som batch. Att kosta på en licens enbart av ovanstående anledning känns inte riktigt rätt.

[MH_]

har du kollat makrot drygt halvvägs ner på den här sidan (How to batch convert doc to docx😞

https://www.pdnob.com/document/doc-to-docx.html

Jag har inte testat. Men det ser rätt ut.

Tyvärr en bild istället för kod så du får bygga lite manuellt.

Kan vara värt att testa i alla fall 

(Och jag antar att Fileformat skall bytast ut mot SaveFormat?)

 

***********ed*********

och här har finns koden i textformat. 

https://www.datanumen.com/blogs/3-quick-ways-to-batch-convert-word-doc-to-docx-files-and-vice-versa/

********************

Redigerad Mars 19 av MH_

[Mikael63]

Tack men där anges en specifik sökväg i koden.

Jag behöver kunna köra detta i "aktuell katalog"

[MH_]

'senaste mappen du jobbade i/sparade i, eller default (tror jag)
Sub tst()
    strFolder  = CurDir()
    MsgBox strFolder 
End Sub

'Om aktuellt dolument är sparat, filens mapp
Sub tst2()
    strFolder  = ActiveDocument.Path
    MsgBox strFolder 
End Sub

'eller visa "öppna med" -dialogen
Sub tst3()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        strFolder  = .SelectedItems(1)
    End With
    
    MsgBox strFolder 
End Sub

 

Redigerad Mars 19 av MH_

[Mikael63]

6 timmar sedan, MH_ sade:

och här har finns koden i textformat.

Den blev visst automatöversatt!

Stäng slutet med slutet med strFile = Dir () Wend Set objWordDocument = Ingenting Set objWordApplication = Nothing End Sub

**

5 timmar sedan, MH_ sade:

ActiveDocument.Path

Japp det blir den jag ska använda och koden nu

Public Sub TranslateDocIntoDocx()
    Dim objWordApplication As New Word.Application
    Dim objWordDocument As Word.Document
    Dim strFile As String
    Dim strFolder As String

'    strFolder = ActiveDocument.Path & "\"
    strFolder = "C:\EgnaDokument\Test\"
    strFile = Dir(strFolder & "*.doc", vbNormal)
' MsgBox strFolder
' MsgBox strFile
While strFile <> ""
    With objWordApplication
        Set objWordDocument = .Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
        
        With objWordDocument
            .SaveAs FileName:=strFolder & Replace(strFile, "doc ", " docx "), FileFormat:=16
            .Close
            End With
        End With
            strFile = Dir()
Wend
        
        Set objWordDocument = Nothing
        Set objWordApplication = Nothing
End Sub

Den körs men jag får

Tänkte först att det knasar när jag försöker köra koden från ett dokument i samma katalog, därför testat med en absolut sökväg lika exemplet men det hjälper inte.

**

Kollar igen på att endast spara

On 2024-03-18 at 14:12, Mikael63 sade:

Att endast köra den sparar filen i samma format, tydligen(?)

Nej! Den sparar med rätt format men filtillägget ändras inte.

Ska testa att peta in

Replace(strFile, "doc ", " docx ")

i den "enklare" koden men behövde posta detta först.

[MH_]

Tag bort alla mellanslag i replace. Och lägg till punkt. Annars lär den missa de flesta.

Replace(strFile, ".doc", ".docx")

[Mikael63]

Public Sub docx()
    Dim objWordApplication As New Word.Application
    Dim objWordDocument As Word.Document
    Dim strFile As String
    Dim strFolder As String

    strFolder = ActiveDocument.Path & "\"
    strFile = ActiveDocument
' MsgBox strFolder
' MsgBox strFile

ActiveDocument.SaveAs2 FileName:=strFolder & Replace(strFile, ".doc", ".docx"), FileFormat:=16
End Sub

Denna funkar!

 

Redigerad Mars 19 av Mikael63
punkt

[Mikael63]

6 minuter sedan, MH_ sade:

Tag bort alla mellanslag i replace. Och lägg till punkt. Annars lär den missa de flesta.

Replace(strFile, ".doc", ".docx")

Japp mellanslagen såg jag och funderade över, de kommer från den maskinöversatta koden.
Har lagt till punkt också

Redigerad Mars 19 av Mikael63

[MH_]

När jag går till sidan så petas det in ett /sv/ i adressen och jag drabbas av maskinöersättningen.

Men om jag ändrar det till /en/ så respekteras det och jag får originalkoden.

[Mikael63]

Hm..

Nu skulle man haft lite fler symboler att välja från

 

Finns något "Extension Pack" tro?

[MH_]

Se upp när du kör "dir". Jag har för mig att den är för generös så att *.doc även hittar .docx.

Du kanske får lägga in en extra koll där du manuellt kollar om

If right(filnamn,4)<>".doc" then
Kör så det ryker
End if

Typ, ungefær

[Mikael63]

Hm..

Nu kör jag detta på en och en fil.

Jag har en "skarp" mapp där detta makro skulle kunna tillämpas. Den består  av 15 filer, alla som .doc och om jag vill snygga till dessa tänker jag att jag öppnar alla, klickar på makroknappen i varje fönster, stänger alla fönster, kontrollerar resultatet, raderar alla .doc

Sedan kan det gå allt från 2 timmar till 2 månader innan liknade procedur kan "behöva" upprepas.

10 minuter sedan, MH_ sade:

så att *.doc även hittar .docx.

Ja, kör jag på en .docx ändras den till en .docxx

Den skulle jag då kunna radera, om det smugit sig in en .docx bland de 15 .doc men jag filar på koden!

[Mikael63]

Public Sub docx()
    Dim objWordApplication As New Word.Application
    Dim objWordDocument As Word.Document
    Dim strFile As String
    Dim strFolder As String

    strFolder = ActiveDocument.Path & "\"
    strFile = ActiveDocument
' MsgBox strFolder
' MsgBox Right(strFile, 4)

If Right(strFile, 4) = ".doc" Then
    ActiveDocument.SaveAs2 FileName:=strFolder & Replace(strFile, ".doc", ".docx"), FileFormat:=16
End If

If Right(strFile, 4) = ".rtf" Then
    ActiveDocument.SaveAs2 FileName:=strFolder & Replace(strFile, ".rtf", ".docx"), FileFormat:=16
End If

End Sub

Behöver de båda "Dim objWord.." ens vara med?

[MH_]

12 timmar sedan, Mikael63 sade:

Behöver de båda "Dim objWord.." ens vara med?

Jag antar att de användes när de körde Sök/ersätt? I din kod ser jag ingen användning för det eftersom du kör "ActiveDocument" . Eller?

[Mikael63]

Ja, de var från koden där en hel radda skulle ersättas. Funkar bra utan de raderna.

Genväg, i Word, för att komma in i VB-editorn? 

I Excel brukar jag högerklicka på Blad - Visa kod.

 

[MH_]

Jag använder av princip tangentbordet

[Alt]+[F11]

Samma som i excel

[Mikael63]

On 2024-03-18 at 14:12, Mikael63 sade:

Funkade rakt av i Excel (behåller namnet på makrot!)

Hm.
När jag kör detta på en skarp fil som heter 1026.XLS får jag detta:

 

Om jag ändrar till 1026.xls fungerar det.

Vaffö då då?

Tillägg:

Märkligt. Testade att skapa en .xls resp. .XLS men det funkade att konvertera. Testade igen med originalfilen, alltså en backup och inte den jag döpt om - fungerar.

Om jag öppnar XLS på nytt och kör får jag varning

Väljer Ja och det lirar.

Ingen större vits att leta ett fel som inte längre finns....

**

Jo, jag vet att Windows inte skiljer på versal/gemen men...

 

Redigerad Mars 21 av Mikael63