convertir DOC, XLS, PPT y TXT a HTML

[Yoston]

Hola
para los que deseen aprender o los que saben crear
controles ActiveX ...aqui les dejo el codigo en visualBasic
para crear una DLL que permite transformar archivos Word,Excel,PowerPoint y txt
a HTML

bueno esta dll tiene una clases Covertir.cls
primero deben abrir el visual basic y crear un nuevo proyecto del tipo DLL activeX
luego ir a el menu Proyecto->Referencia y deben agregar en referencia:

"Microsoft Word 9 Object Library"
"Microsoft Excel 9 Object Library"
"Microsoft PowerPoint 9 Object Library"
"Microsoft Office 9 Object Library"

ok...crearemos la clase

*Covertir.cls*

Function Word(DocPath As String, RutaHtml As String) As Integer
Dim Hoja As Word.Application
Set Hoja = New Word.Application
Hoja.Documents.Open FileName:=DocPath, ReadOnly:=True
Hoja.ActiveDocument.SaveAs FileName:=RutaHtml, FileFormat:=wdFormatHTML
Hoja.Quit
Set Hoja = Nothing
DoEvents
Word = 1
Exit Function
End Function

Function Excel(DocPath As String, RutaHtml As String) As Integer
Dim Hoja As Excel.Application
Set Hoja = New Excel.Application
Hoja.Workbooks.Open FileName:=DocPath, ReadOnly:=True
Hoja.ActiveWorkbook.SaveAs FileName:=RutaHtml, FileFormat:=xlHtml
Hoja.Quit
Set Hoja = Nothing
DoEvents
Excel = 1
Exit Function
End Function

Function PowerPoint(DocPath As String, RutaHtml As String) As Integer
Dim Hoja As PowerPoint.Application
Set Hoja = New PowerPoint.Application
Hoja.Visible = True
Hoja.Presentations.Open FileName:=DocPath, ReadOnly:=True
Hoja.ActivePresentation.SaveAs FileName:=RutaHtml, FileFormat:=ppSaveAsHTML, EmbedTrueTypeFonts:=msoTrue
Hoja.Quit
Set Hoja = Nothing
PowerPoint = 1
Exit Function
End Function


Sigue.....

[Yoston]

Function Transformar(ByVal DocPath As String, ByVal Tipo As String, Optional ByRef DestDir As String) As String
Dim TmpPath As String
Dim FileName As String
Dim File As String
Dim archivo As String
TmpPath = TempDir() & "Doc2HTML\"
On Error Resume Next
MkDir TmpPath
On Error GoTo 0
If DestDir = "" Then DestDir = TmpPath
If Right$(DestDir, 1) <> "\" Then DestDir = DestDir & "\"
SplitPath DocPath, Title:=FileName
File = Dir$(TmpPath & "*")
Do While Len(File)
Kill TmpPath & File
File = Dir$
Loop
archivo = DestDir & FileName & ".htm"
Select Case UCase(Tipo)
Case "DOC": TransformarDocumentos = Word(DocPath, archivo)
Case "XLS": TransformarDocumentos = Excel(DocPath, archivo)
Case "PPT": TransformarDocumentos = PowerPoint(DocPath, archivo)
Case "PPS": TransformarDocumentos = PowerPoint(DocPath, archivo)
Case "TXT": TransformarDocumentos = Word(DocPath, archivo)
Case Else
TransformarDocumentos = "2"
End Select
If DestDir <> TmpPath Then
On Error Resume Next
MkDir DestDir
On Error GoTo 0
File = Dir$(TmpPath & "*")
Do While Len(File)
FileCopy TmpPath & File, DestDir & File
Kill TmpPath & File
File = Dir$
Loop
On Error Resume Next
RmDir TmpPath
On Error GoTo 0
End If
If TransformarDocumentos = "1" Then
Transformar = "La Transformacion del Archivo fue Exitosa"
Else
Transformar = "Transformacion para este Archivo no disponible"
End If
End Function

Private Function TempDir() As String
Static Path As String
If Path = "" Then
Path = Environ$("TEMP")
If Path = "" Then
Path = Environ$("TMP")
If Path = "" Then Path = "C:\Temp"
End If
If Right$(Path, 1) <> "\" Then Path = Path & "\"
On Error Resume Next
MkDir Path
On Error GoTo 0
End If
TempDir = Path
End Function

sigue....

[Yoston]

Private Sub SplitPath(ByVal Fullpath As String, _
Optional ByRef Drive As String, _
Optional ByRef Path As String, _
Optional ByRef File As String, _
Optional ByRef Title As String, _
Optional ByRef Suffix As String)
Dim iPos As Long
If Mid$(Fullpath, 2, 1) = ":" Then
Drive = Left$(Fullpath, 2)
Fullpath = Mid$(Fullpath, 3)
ElseIf Left$(Fullpath, 2) = "\\" Then
iPos = InStr(3, Fullpath, "\")
Drive = Left$(Fullpath, iPos - 1)
Fullpath = Mid$(Fullpath, iPos)
End If
For iPos = Len(Fullpath) To 1 Step -1
If Mid$(Fullpath, iPos, 1) = "\" Then Exit For
Next iPos
Path = Left$(Fullpath, iPos)
File = Mid$(Fullpath, iPos + 1)
For iPos = Len(File) To 1 Step -1
If Mid$(File, iPos, 1) = "." Then Exit For
Next iPos
If iPos Then
Title = Left$(File, iPos - 1)
Suffix = Mid$(File, iPos + 1)
Else
Title = File
Suffix = ""
End If
End Sub
***************
Compilamos nuestro proyecto y generamos la DLL
si es necesario registramos la DLL
regsvr32 midll.dll
y ya....vamos a la pagina ASP
******pagina.asp*******
<%
dim x
set x = CreateObject("midll.covertir")
'->transformar([documeto],[Tipo],[Destino])
'->Tipo:doc,txt,xls,ppt
response.write x.transformar("c:\Documento.doc","D OC","c:\inetpub\wwwroot\")
response.write x.transformar("c:\Excel.doc","xls&q uot;,"c:\")
response.write x.transformar("c:\Presentacion.ppt",&quo t;ppt","a:\")
response.write x.transformar("c:\texto.txt","TXT&q uot;,"a:\")
set x = nothing
%>
el archivo sera guardado con el mismo nombre pero .htm ej:
transformar("c:\Excel.doc","xls&quo t;,"c:\")
en el dir c:\ quedara un archivo Excel.htm
*******en visual Basic**********
Private Sub Transforma_Click()
dim t
set t= createObject("midll.Convertir")
msgbox t.transformar("c:\Excel.doc","xls&q uot;,"c:\")
set t= nothing
End Sub

bueno espero que le sirva a alguien.
gracias por su tiempo.
si alguien vive en miami y tiene trabajo me avisa
chausito..

[ElAprendiz]

Hola Yoston. Saludos desde tu tierra

no se mucho de VB, pero este codigo funciona con VB 5.

<center><IMG SRC="http://www.550m.com/usuarios/altolacruz/elaprendiz.gif" ALT="Visitame en AlSurNet.com -- E-Learning E-Commerce Multimedia E-business--"></center>

[u_goldman]

Cielos...tema cerrado por favor no revivir temas.