conversie htm in xls cu linie de comnada

[Imre]

Cum convertesc mai multe fisiere htm in xls fara interventie operator ?
Adica ma intereseaza o idee cum sa lansez aceste conversii in forma:
excel /switchuri fisier1.htm fisier1.xlsx
excel /switchuri fisier2.htm fisier2.xlsx

[Dr.Windows]

Nu cred ca asa ceva este posibil... pentru ca nu are de unde sa "stie" Excelul cum arata datele din acel HTML ca sa-l "transpuna" in XLS.
Cu un cod VBA in schimb cred ca se poate sau poate char folosind WebQuery din Excel.

Poti sa atasezi aici un HTML de "model"?...

[smcsa]

Nu exista asemenea switch-uri
http://office.microsoft.com/en-us/excel ... 01033.aspx

[Imre]

Lucian, atasez htm-ul.

[Dr. Cloud]

In ThisWorkbook pui urmatorul cod:

Cod: Selectaţi tot

Private Sub Workbook_Open()
On Error GoTo err
    Workbooks.Open Filename:= _
        ThisWorkbook.Path & "\RECEPTII.HTM"
    Exit Sub
    
err:
    MsgBox err.Description, vbOKOnly + vbInformation, "Eroare"
End Sub

Atunci cand deschizi fisierul Excel, acesta va importa fisierul tau *.html.
Fisierul Excel va trebui sa stea langa fisierele *.html.

[Dr. Cloud]

Revin cu un update.

Cod: Selectaţi tot

'---------------------------------------------------------------------------
' *************************************************************************
'  Descriere : Acest cod va copia toate fisierele *.HTM dintr-un folder
'               si le va muta in altul transformandu-le in fisiere Excel.
'---------------------------------------------------------------------------
'  Nota      : Acest cod trebuie luat asa cum este.
'              Orice test se va efectua pe o copie a datelor originale
'  Sursa     : http://www.vbaexpress.com/kb/getarticle.php?kb_id=827
' *************************************************************************
'  Author    : Alexandru Dionisie
'  Date      : 28.11.2009
'  Website   : http://www.drexcel.ro
'---------------------------------------------------------------------------



Option Explicit
 'Referinta catre Windows Script Host Object Model

Sub TransformareHTML()
     
    Dim objFSO As FileSystemObject, objFolder As Folder, PathExists As Boolean
    Dim objFile As File, strSourceFolder As String, strDestFolder As String
    Dim x, Counter As Integer, Overwrite As String, strNewFileName As String
    Dim strName As String, strMid As String, strExt As String
     
    Application.ScreenUpdating = False
    Application.EnableEvents = False
     

    strSourceFolder = "C:\De transformat"
    strDestFolder = "C:\Finalizate"
     

    On Error Resume Next
    x = GetAttr(strDestFolder) And 0
    If Err = 0 Then
        PathExists = True
        Overwrite = MsgBox("Este posibil ca acest folder sa contina fisiere duplicate." & vbNewLine & _
        "Vrei sa inlocuiesti fisierele care au acelasi nume?", vbYesNo, "Alerta!")
        If Overwrite <> vbYes Then Exit Sub
Else:
        PathExists = False
        If PathExists = False Then MkDir (strDestFolder)
    End If
     
    On Error GoTo ErrHandler
    Set objFSO = New FileSystemObject
    Set objFolder = objFSO.GetFolder(strSourceFolder)
    Counter = 0
     
    If Not objFolder.Files.Count > 0 Then GoTo NoFiles
     
    For Each objFile In objFolder.Files
         
        strName = Left(objFile.Name, Len(objFile.Name) - 4)
        strExt = Right(objFile.Name, 4)
        strNewFileName = strName & ".xlsx"
        objFile.Copy strDestFolder & "\" & strNewFileName
         

        Counter = Counter + 1
    Next objFile
     
    MsgBox "Transfer Complet", vbOKOnly + vbInformation, "Transfer fisiere"

     
    Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
     
    Exit Sub
     
NoFiles:
    MsgBox "Nu exista niciun fisier in : " & vbNewLine & vbNewLine & _
    strSourceFolder & vbNewLine & vbNewLine & "Te rog sa verifici!", , "Alerta: Niciun fisier gasit!"
    Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing
     
    Application.ScreenUpdating = True
    Application.EnableEvents = True '
     
    Exit Sub
     
ErrHandler:
        MsgBox "Te rog sa verifici ca nu cumva fisierele sa fie deschise," & _
        "si ca folderul exista"
     
    Err.Clear
    Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Creezi doua foldere:
- C:\De transformat
- C:\Finalizate
In folderul de transformat pui toate fisierel *.htm
Dupa ce rulezi codul, acestea vor deveni fisiere Excel.
In plus te rog sa rulezi una dintre cele doua chei de registrii, in functie de versiunea de Excel pe care o ai.
Aceste chei de registrii intaresc extensia fisierelor create.

Te rog sa testezi codul pe copii ale fisierlor originale.

[Dr. Cloud]

Daca tot vrei sa nu existe alte interventii din partea operatorilor, am modificat putin codul:

Cod: Selectaţi tot

    '---------------------------------------------------------------------------
    ' *************************************************************************
    '  Descriere : Acest cod va copia toate fisierele *.HTM dintr-un folder
    '               si le va muta in altul transformandu-le in fisiere Excel.
    '---------------------------------------------------------------------------
    '  Nota      : Acest cod trebuie luat asa cum este.
    '              Orice test se va efectua pe o copie a datelor originale
    '  Sursa     : http://www.vbaexpress.com/kb/getarticle.php?kb_id=827
    ' *************************************************************************
    '  Author    : Alexandru Dionisie
    '  Date      : 28.11.2009
    '  Website   : http://www.drexcel.ro
    '---------------------------------------------------------------------------



    Option Explicit
    'Referinta catre Windows Script Host Object Model

    Sub Workbook_Open()
         
        Dim objFSO As FileSystemObject, objFolder As Folder, PathExists As Boolean
        Dim objFile As File, strSourceFolder As String, strDestFolder As String
        Dim x, Counter As Integer, Overwrite As String, strNewFileName As String
        Dim strName As String, strMid As String, strExt As String
         
        Application.ScreenUpdating = False
        Application.EnableEvents = False
         

        strSourceFolder = "C:\De transformat"
        strDestFolder = "C:\Finalizate"
         

        On Error Resume Next
        x = GetAttr(strDestFolder) And 0
        If Err = 0 Then
            PathExists = True
            Overwrite = MsgBox("Este posibil ca acest folder sa contina fisiere duplicate." & vbNewLine & _
            "Vrei sa inlocuiesti fisierele care au acelasi nume?", vbYesNo, "Alerta!")
            If Overwrite <> vbYes Then Exit Sub
    Else:
            PathExists = False
            If PathExists = False Then MkDir (strDestFolder)
        End If
         
        On Error GoTo ErrHandler
        Set objFSO = New FileSystemObject
        Set objFolder = objFSO.GetFolder(strSourceFolder)
        Counter = 0
         
        If Not objFolder.Files.Count > 0 Then GoTo NoFiles
         
        For Each objFile In objFolder.Files
             
            strName = Left(objFile.Name, Len(objFile.Name) - 4)
            strExt = Right(objFile.Name, 4)
            strNewFileName = strName & ".xlsx"
            objFile.Copy strDestFolder & "\" & strNewFileName
             

            Counter = Counter + 1
        Next objFile
         
        MsgBox "Transfer Complet", vbOKOnly + vbInformation, "Transfer fisiere"

         
        Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects
         
        Exit Sub
         
NoFiles:
        MsgBox "Nu exista niciun fisier in : " & vbNewLine & vbNewLine & _
        strSourceFolder & vbNewLine & vbNewLine & "Te rog sa verifici!", , "Alerta: Niciun fisier gasit!"
        Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing
         
        Application.ScreenUpdating = True
        Application.EnableEvents = True '
         
        Exit Sub
         
ErrHandler:
        MsgBox "Te rog sa verifici ca nu cumva fisierele sa fie deschise," & _
        "si ca folderul exista"
         
        Err.Clear
        Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    ActiveWorkbook.Close
End Sub

In plus, am convertit fisierul Excel intr-un executabil.
Dupa ce il rulezi, el va face conversia fisierelor si apoi se va inchide singur.

[Imre]

Am verificat in 2003, dar doar copiaza htm-urile cu alta extensie, nu face si transformare.
Cred ca o solutie combinata va fi buna:
- open alt workbook (vezi propunerea lui Lucian) sau chiar in alt sheet. De fapt, daca solutia este cu VBA e mai bine ca toate sa fie in cite un sheet,
- save as si inchidere aplicatie

[Dr.Windows]

Lamuriri suplimentare:

1. HTML-urile pe care le vrei convertite se vor modifica in continut si vrei sa le importi inca o data (sau sa acutalizezi XLS-ul pe baza lor) sau se modifica cu totul... adica inclusiv numele de fisier si trebuiesc reimportate inca o data in alte fisiere XLS?

2. Vrei ca HTML-urile importate sa fie aduse in fisiere XLS separate sau in acelasi XLS dar Sheet-uri separate?...

[Imre]

Lucian,
1. prefer un xls propriu-zis, se va prelucra ulterior.
2. daca tot trebuie VBA, atunci prefer un singur xls cu cate un sheet pe htm, dar
mai important este ca totul sa se execute fara interventie operator.
Imre