[ vojvoda1010 @ 08.09.2018. 11:34 ] @
imam u folderu vise html dokumenta koje preba pa prebacim u word dokumente. da li postoji kovertor za ovako nesto ili VBA code? |
[ vojvoda1010 @ 08.09.2018. 11:34 ] @
[ bokinet @ 08.09.2018. 15:41 ] @
HTML stranice se mogu otvoriti u MS Word i iste mogu da se edituju.
Problem je u kompleksnosti HTML sadrzaja koji moze da se nalazi na samoj HTML strani (tj. stranicama) i konverzije u MS Word. Na to utice dosta faktora od stilova pa do velicine sadrzaja... U svakom slucaju, neki postupak bi bio: 1. Otvori se html file u MS Word; 2. Snimi se kao MS Word dokument sa SAVE AS ili sa EXPORT komandom; Moze rucno a moze i kroz VBA kod. Dodatak: Takodje treba obratiti na multimedijalni sadrzaj koji prati web stranu da li ce se koristi samo URI/URL ka njima ili ces se ubaciti kao sastavni deo MS Word dokumenta isti, prilikom snimanja. Na primer, slike i sl. / embed images i sl. [ vojvoda1010 @ 08.09.2018. 18:12 ] @
a da li moze da se vise html dokumenta automatski otvore i snime u word dokumeta, posto ih imam bas mnogo.
nesto sam ovde nasao ali ne znam http://www.vbforums.com/showth...-Convert-html-to-word-document [ bokinet @ 08.09.2018. 18:23 ] @
Moze da se automatizuje ceo proces preko VBA.
Na primer: 1. Napravi se prvo deo koda koji radi sve za jedan dokumenta - recimo f-ja koja ima ulaznu vrednost za lokaciju html file a izlaznu vrednost vraca status. U okviru te f-je vrsi se otvaranje/ucitavanje file-a i eksport u novi file i vrsi promena tipa file-a tj. konverzija; 2. Potom se napravi deo koda koji pravi listu fileova i/ili recimo deo gde se biraju file-ovi koji se konvertuju - sa/bez GUI (grafickog korisnickog interfejsa); 3. Onda se kroz petlju tj. za svaki odabrani file iz liste iz br. 2, poziva deo koda iz br. 1 4. i eventualno generise izvestaj uspesnosti konverzije/eksporta za svaki file-a u vidu poruke ili nekog teksta ili debug info. Videti recimo komandu DIR u VBA, cemu sluzi i kako se ista koristi kao i ostale komande u VBA. [ vojvoda1010 @ 09.09.2018. 08:38 ] @
Sub SaveAllAsDOCX()
'Search #EXT to change the extensions to save to docx Dim strDocName As String Dim strPath As String Dim oDoc As Document Dim fDialog As FileDialog Dim intPos As Integer 'Create a folder dialog Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) With fDialog .Title = "Select root folder and click OK" .AllowMultiSelect = False .InitialView = msoFileDialogViewList If .Show <> -1 Then MsgBox "Cancelled By User", , "List Folder Contents" Exit Sub End If 'Select root folder strPath = fDialog.SelectedItems.Item(1) 'Ensure the Folder Name ends with a "\" If Right(strPath, 1) <> "\" Then strPath = strPath + "\" End With 'Close any open documents If Documents.Count > 0 Then Documents.Close SaveChanges:=wdPromptToSaveChanges End If 'remove any quotes from the folder string If Left(strPath, 1) = Chr(34) Then strPath = Mid(strPath, 2, Len(strPath) - 2) End If 'begin recusion recurse (strPath) End Sub 'This method controls the recusion Function recurse(folder As String) 'save all the files in the current folder SaveFilesInFolder (folder) 'get all the subfolders of the current folder Dim folderArray folderArray = GetSubFolders(folder) 'Loop through all the non-empty elements for folders For j = 1 To UBound(folderArray) If folderArray(j) <> "" Then 'begin recusion on subfolder recurse (folder & folderArray(j) & "\") End If Next End Function 'Saves all files with listed extensions Function SaveFilesInFolder(folder As String) 'List of extensions to look for #EXT Dim strFilename As String extsArray = Array("*.rtf", "*.doc") 'Loop through extensions For i = 0 To (UBound(extsArray)) 'select the 1st file with the current extension strFilename = Dir(folder & extsArray(i), vbNormal) 'double check the current extension (don't to resave docx files) Dim ext As String ext = "" On Error Resume Next ext = Right(strFilename, 5) If ext = ".docx" Or ext = "" Then 'Don't need to resave files in docx format Else 'Save the current file in docx format While Len(strFilename) <> 0 Set oDoc = Documents.Open(folder & strFilename) strDocName = ActiveDocument.FullName intPos = InStrRev(strDocName, ".") strDocName = Left(strDocName, intPos - 1) strDocName = strDocName & ".docx" oDoc.SaveAs FileName:=strDocName, _ FileFormat:=wdFormatDocumentDefault oDoc.Close SaveChanges:=wdDoNotSaveChanges strFilename = Dir Wend End If Next strFilename = "" End Function 'List all the subfolders in the current folder Function GetSubFolders(RootPath As String) Dim FS As New FileSystemObject Dim FSfolder As folder Dim subfolder As Variant Set FSfolder = FS.GetFolder(RootPath) 'subfolders is variable length Dim subfolders() As String ReDim subfolders(1 To 10) Dim i As Integer i = LBound(subfolders) For Each subfolder In FSfolder.subfolders subfolders(i) = subfolder.Name 'increase the size of subfolders if it's needed i = i + 1 If (i >= UBound(subfolders)) Then ReDim subfolders(1 To (i + 10)) End If Next subfolder Set FSfolder = Nothing GetSubFolders = subfolders End Function na netu sam nasao pa ne znam da li je to to, doalzim do greske i to u Function GetSubFolders(RootPath As String) Dim FS As New FileSystemObject u vidu compile error: user-defined type nit defined [ bokinet @ 09.09.2018. 11:17 ] @
Dodati referencu u Microsoft Scripting RunTime
Menu TOOLS -> REFERENCES, pa u listi pronaci 'Microsoft Scripting RunTime' i odabrati (cekirati). [ vojvoda1010 @ 09.09.2018. 11:55 ] @
sada ne mogu da nadjem gde snima dokumente
[ bokinet @ 09.09.2018. 12:02 ] @
Code: 'Saves all files with listed extensions Function SaveFilesInFolder(folder As String) 'List of extensions to look for #EXT Dim strFilename As String extsArray = Array("*.rtf", "*.doc") 'Loop through extensions For i = 0 To (UBound(extsArray)) 'select the 1st file with the current extension strFilename = Dir(folder & extsArray(i), vbNormal) 'double check the current extension (don't to resave docx files) Dim ext As String ext = "" On Error Resume Next ext = Right(strFilename, 5) If ext = ".docx" Or ext = "" Then 'Don't need to resave files in docx format Else 'Save the current file in docx format While Len(strFilename) <> 0 Set oDoc = Documents.Open(folder & strFilename) strDocName = ActiveDocument.FullName intPos = InStrRev(strDocName, ".") strDocName = Left(strDocName, intPos - 1) strDocName = strDocName & ".docx" oDoc.SaveAs FileName:=strDocName, _ FileFormat:=wdFormatDocumentDefault oDoc.Close SaveChanges:=wdDoNotSaveChanges strFilename = Dir Wend End If Next strFilename = "" End Function Ubaciti iznad koda 'oDoc.SaveAs....' ako treba da se vidi informativno gde je za debug potrebe. Code: debug.print now,strDocName [ vojvoda1010 @ 09.09.2018. 12:51 ] @
pokusavam ali ne uspevam
izgleda da nisam na pravom putu [ bokinet @ 09.09.2018. 14:17 ] @
A sta kazu znakovi pored puta kojim se ide pogresno?
Koje su greske, vrednosti promenljivih i sl. tkz. debug info.? Malo vise reci ne bi skodilo... I'm just a messenger, so don't kill a messenger. [ vojvoda1010 @ 09.09.2018. 14:50 ] @
ne prepoznaje uopste html dokument, kada se nudi sta da konvertujem.
a nista bne pokazuje kao gresku, samo ne mogu da nadjem snimljen file [ bokinet @ 09.09.2018. 15:05 ] @
Uzorci html-a koji se konvertuju ne bi bilo lose da se priloze kako bi se videlo i ispratilo sve sta se hoce.
[ vojvoda1010 @ 09.09.2018. 15:17 ] @
u prilogu
[ bokinet @ 09.09.2018. 15:35 ] @
U prilogu je odradjen MS Word file na osnovu datog HTML file-a rucno.
Znaci konverzija je moguca. Ako stignem i kad stignem, videcu i kod da odradim za to. [ vojvoda1010 @ 10.09.2018. 17:53 ] @
Sub convertToWord()
Dim MyObj As Object, MySource As Object, file As Variant file = Dir("C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" & "*.html") 'pdf path Do While (file <> "") ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" Documents.Open FileName:=file, ConfirmConversions:=False, ReadOnly:= _ False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _ "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _ Format:=wdOpenFormatAuto, XMLTransform:="" ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" 'path for saving word ActiveDocument.SaveAs2 FileName:=Replace(file, ".html", ".docx"), FileFormat:=wdFormatXMLDocument _ , LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False, CompatibilityMode:=15 ActiveDocument.Close file = Dir Loop End Sub run time errorr kod CompatibilityMode:=15 [ bokinet @ 10.09.2018. 18:01 ] @
Prilog fali kao file za uzorak.
Probati u kodu da se ispravi vrednost za promenljivu CompatibilityMode:=15 ili da se ista izbaci. wdCurrent 65535 Compatibility mode equivalent to the latest version of Word. wdWord2003 11 Word is put into a mode that is most compatible with Word 2003. Features new to Word are disabled in this mode. wdWord2007 12 Word is put into a mode that is most compatible with Office Word 2007. Features new to Wordare disabled in this mode. wdWord2010 14 Word is put into a mode that is most compatible with . Features new to Wordare disabled in this mode. wdWord2013 15 Default. All Word features are enabled. [ bokinet @ 10.09.2018. 18:09 ] @
Takodje moze da se koristi SaveAs() metoda ako nisu potrebne dodatne stvari prilikom snimanja dokumenta. Videti dokumentaciju za razlike izmedju SaveAs() i SaveAs2().
[ vojvoda1010 @ 10.09.2018. 21:00 ] @
to je to izbacio sam CompatibilityMode jer sa njim nije htelo.
jos samo ako uspem da moze da se bira odakle da snimi i gde da snimi [ bokinet @ 10.09.2018. 22:50 ] @
FileName:=file -> File koji se otvara (znaci fizicka lokacija file-a)
drugi deo je FileName:=Replace(file, ".html", ".docx") -> Lokacija i file gde se snima. Ja ovde ne vidim sta je sporno kad je sve jasno i cisto sto se tice lokacija i nacina upotrebe? [ vojvoda1010 @ 11.09.2018. 05:44 ] @
macro radi super, nego sam mislio na to kada se pokrene macro da mogu da biram folder iz koga konvertujem i folder u koji konvertujem
[ bokinet @ 11.09.2018. 14:28 ] @
Evo f-je koja sluzi za prikaz tkz. dialog Browse for folders.
Pored iste, dat je i primer kako moze ista da se pozove. Ovo moze da se modifikuje shodno potrebama. U vasem slucaju, znaci f-ja se poziva dva puta - kako ste naveli za 'da mogu da biram folder iz koga konvertujem i folder u koji konvertujem'. U svakom slucaju sta je sa nazivimi file-ova, posto folder (direktorijum) i file nisu isto? Code: Public Function DialogBrowseForFolder(Optional ByVal MultiSelect As Boolean = False, Optional InitialFileName As String = "") As String On Error GoTo ErrHandler Dim f As FileDialog Dim r As String r = "" Set f = Application.FileDialog(msoFileDialogFolderPicker) With f .Title = "Odaberite lokaciju (folder)" .AllowMultiSelect = MultiSelect .InitialFileName = InitialFileName If .Show = -1 Then r = .SelectedItems(1) End With If Len(Trim(r)) > 0 Then If Right(r, 1) <> "\" Then r = r & "\" Debug.Print Now, "DialogBrowseForFolder()", MultiSelect, InitialFileName, "Return value: "; r DialogBrowseForFolder = r Set f = Nothing Exit Function ErrHandler: ' Prikazi poruku MsgBox "Doslo je do greske prilikom pokusaja odabira lokacije (folder)" & vbCrLf & vbCrLf & "Greska #" & Err.Number & " - " & Err.Description, vbCritical, "" Debug.Print Now, "DialogBrowseForFolder() Error", MultiSelect, InitialFileName, r End Function Sub PrimerKoriscenja() Dim r As String r = DialogBrowseForFolder(False, "") If Len(Trim(r)) > 0 Then Debug.Print "Lokacija je odabrana. Lokacija: "; r Else Debug.Print "Lokacija nije odabrana." End If End Sub [ vojvoda1010 @ 11.09.2018. 18:59 ] @
ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" to sam hteo u ovom delu koda da iskoristim, ako mi se dokumenta nalaze u drugom folderu a ne navedenom u kodu [ bokinet @ 11.09.2018. 19:28 ] @
sorry, nisam najbolje razumeo sta se hoce...
[ vojvoda1010 @ 12.09.2018. 19:52 ] @
pa se u prethodnom kodu ubaci putanja (folder) iz koje se povlaci html, do putanje gde se konvertovani word salje (folder)
[ bokinet @ 12.09.2018. 21:58 ] @
Ja vas opet nisam razumeo kao i na koji prethodni kod se odnosi sto ste naveli...
Malo vise pojasnjenja, uzoraka, primer i sl. nije na odmet - ako zelite da vas neko razume su dobro dosli! [ vojvoda1010 @ 14.07.2019. 09:48 ] @
kako ova dva koda spojiti:
Sub convertToWord() Dim MyObj As Object, MySource As Object, file As Variant file = Dir("C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" & "*.html") 'pdf path Do While (file <> "") ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" Documents.Open FileName:=file, ConfirmConversions:=False, ReadOnly:= _ False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _ "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _ Format:=wdOpenFormatAuto, XMLTransform:="" ChangeFileOpenDirectory "C:\Users\Korisnik\Desktop\PRAKSA SUDOVA\APELACIONU SUD KRAGUJEVAC\naknada stete\html\" 'path for saving word ActiveDocument.SaveAs2 FileName:=Replace(file, ".html", ".docx"), FileFormat:=wdFormatXMLDocument _ , LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False, CompatibilityMode:=15 ActiveDocument.Close file = Dir Loop End Sub Public Function DialogBrowseForFolder(Optional ByVal MultiSelect As Boolean = False, Optional InitialFileName As String = "") As String On Error GoTo ErrHandler Dim f As FileDialog Dim r As String r = "" Set f = Application.FileDialog(msoFileDialogFolderPicker) With f .Title = "Odaberite lokaciju (folder)" .AllowMultiSelect = MultiSelect .InitialFileName = InitialFileName If .Show = -1 Then r = .SelectedItems(1) End With If Len(Trim(r)) > 0 Then If Right(r, 1) <> "\" Then r = r & "\" Debug.Print Now, "DialogBrowseForFolder()", MultiSelect, InitialFileName, "Return value: "; r DialogBrowseForFolder = r Set f = Nothing Exit Function ErrHandler: ' Prikazi poruku MsgBox "Doslo je do greske prilikom pokusaja odabira lokacije (folder)" & vbCrLf & vbCrLf & "Greska #" & Err.Number & " - " & Err.Description, vbCritical, "" Debug.Print Now, "DialogBrowseForFolder() Error", MultiSelect, InitialFileName, r End Function Sub PrimerKoriscenja() Dim r As String r = DialogBrowseForFolder(False, "") If Len(Trim(r)) > 0 Then Debug.Print "Lokacija je odabrana. Lokacija: "; r Else Debug.Print "Lokacija nije odabrana." End If End Sub Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|