Convert Excel to HTML and ftp upload
Start Visual Studio.
Click OK.
Imports
System.IO
Imports
System.Data
Imports
System.Net
Imports
System.Threading
Imports
System.Net.Sockets
Imports
MySql.Data.MySqlClient
Public Class ThisAddIn
Public
status As String
Private Sub ThisAddIn_Startup() Handles
Me.Startup
Dim
theFile As String
= getFilename()
Application.Workbooks.Open("E:\webapp\ppm\upload\PPM\DAILYFLASH\"
& theFile)
status = status & " Loading xlsx "
Dim
touploadFile As String
= "E:\winapps\dailyFlashExcel2Html\dailyFlashExcel2Html\bin\Debug\htm\"
& "dfcr" & Left(theFile,
8) & ".mht"
status = status & " Converting to HTML " &
Application.Path & "\htm\"
Application.AlertBeforeOverwriting = False
Application.ActiveWorkbook.SaveAs(touploadFile, Excel.XlFileFormat.xlWebArchive)
status = status & " Converting to HTML "
Application.ActiveWorkbook.Close()
'start upload
FtpUploadFileToServer("191.254.1.42", touploadFile, "/var/www/dp/ext/ppmmob/files/dailycompile/",
, "****", "****", , True)
makeLog()
ThisAddIn_Shutdown()
' MsgBox(status)
Me.Application.Quit()
End Sub
Private Sub ThisAddIn_Shutdown() Handles
Me.Shutdown
End Sub
Private Function getFilename() As
String
ConnectDatabase()
Dim
result As String
= ""
Try
Dim
cmd As MySqlCommand
= New MySqlCommand("SELECT filename FROM `upload_cmg` WHERE type =
'DAILYFLASH' order by last_updated desc limit 1", conn)
Dim
reader As MySqlDataReader
Dim
dt As New DataTable
reader = cmd.ExecuteReader ''cmd.ExecuteNonQuery() for update operation
dt.Load(reader)
Dim
i As Integer =
dt.Rows.Count
Dim
j As Integer =
0
While
j < i
result =
dt.Rows(j).Item(0).ToString
' ipaddress(j, 1) = dt.Rows(j).Item(1).ToString
j = j + 1
End
While
reader.Close()
DisconnectDatabase()
Return
result
Catch
myerror As Exception
DisconnectDatabase()
Return
"error"
End Try
End Function
Public conn
As New MySqlConnection
Public Sub ConnectDatabase()
Try
If
conn.State = ConnectionState.Closed Then
conn.ConnectionString = "DATABASE=entertrack;" _
& "SERVER=191.254.1.42;user
id=admin;password=nimda;port=3306;charset=utf8"
conn.Open()
End
If
Catch
myerror As Exception
MsgBox("Error
Connecting to the database", "Error
Database Server", _
)
End Try
End Sub
Public Sub DisconnectDatabase()
Try
conn.Close()
Catch myerror As
MySql.Data.MySqlClient.MySqlException
End Try
End Sub
Private Function FtpUploadFileToServer(ByVal pServer As String, _
ByVal pUploadPathAndFileName As
String, _
Optional ByVal
pTargetPath As String
= "", _
Optional ByVal
pTargetFileName As String
= "", _
Optional ByVal
pUserName As String
= "", _
Optional ByVal
pPassword As String
= "", _
Optional ByVal pPort As Integer = 21, _
Optional ByVal
pUsePassive As Boolean
= False) As Boolean
Dim
objUploadStream As FileStream
= Nothing
Dim
objRequest As FtpWebRequest
= Nothing
Dim
objResponse As FtpWebResponse
= Nothing
Dim
objRequestStream As Stream
= Nothing
Try
status = status & " initiating upload " &
pUploadPathAndFileName
objUploadStream = File.OpenRead(pUploadPathAndFileName)
Dim
bytBuffer(CType(objUploadStream.Length, Integer)) As Byte
objUploadStream.Read(bytBuffer, 0,
bytBuffer.Length)
If
pTargetFileName.Length = 0 Then
pTargetFileName = IO.Path.GetFileName(objUploadStream.Name)
End
If
Dim
strUrl As String
= String.Format("ftp://{0}:{1}/{2}/{3}",
_
pServer, pPort, pTargetPath, pTargetFileName)
objRequest = CType(FtpWebRequest.Create(strUrl),
FtpWebRequest)
If
pUserName.Length > 0 And pPassword.Length
> 0 Then
objRequest.Credentials = New NetworkCredential(pUserName,
pPassword)
End
If
objRequest.Method = WebRequestMethods.Ftp.UploadFile
objRequest.Proxy = Nothing
objRequest.KeepAlive = False
objRequest.UsePassive = pUsePassive
objRequestStream =
objRequest.GetRequestStream()
objRequestStream.Write(bytBuffer,
0, bytBuffer.Length)
objRequestStream.Close()
objResponse = CType(objRequest.GetResponse, FtpWebResponse)
'MsgBox(objResponse.StatusDescription)
status = status & " - " &
objResponse.StatusDescription & " at
" & Now.TimeOfDay.ToString & "
->"
'
''############################################################
''set
permission
'Dim
mytcp As New TcpClient
'mytcp.Connect(pServer,
21)
'Dim
tcpStream As NetworkStream = mytcp.GetStream
'Dim
writer As StreamWriter = New StreamWriter(tcpStream)
'Dim
reader As StreamReader = New StreamReader(tcpStream)
'writer.AutoFlush
= True
'writer.WriteLine("USER
" + pUserName)
'writer.WriteLine("PASS
" + pPassword)
'writer.WriteLine("PASV")
''writer.WriteLine("CHMOD
444 *.pdf")
'writer.WriteLine("rm
*.pdf")
'status =
status & reader.ReadLine
''writer.WriteLine("CHMOD
444 " & pTargetPath & pTargetFileName)
'mytcp.Close()
Catch
ex As Exception
'MsgBox(ex.Message)
status = status & ex.Message
& "->"
Finally
Try
If
Not objRequestStream Is
Nothing Then
objRequestStream.Close()
End
If
If
Not objUploadStream Is
Nothing Then
objUploadStream.Close()
objUploadStream.Dispose()
End
If
If
Not objRequest Is
Nothing Then
objRequest = Nothing
End
If
Catch
ex As Exception
'MsgBox(ex.Message)
status = status & vbCrLf
& ex.Message
End
Try
End Try
End Function
Private Function makeLog() As
Boolean
Dim
path As String
= "E:\winapps\dailyFlashExcel2Html\dailyFlashExcel2Html\bin\Debug\log.txt"
Dim sw As StreamWriter
' This text
is added only once to the file.
If File.Exists(path) = False
Then
' Create
a file to write to.
sw = File.CreateText(path)
sw.Flush()
sw.Close()
End If
' This text
is always added, making the file longer over time
' if it is
not deleted.
sw = File.AppendText(path)
sw.WriteLine("<<<<<<<<<<<<<<<")
sw.WriteLine(status)
sw.WriteLine(">>>>>>>>>>>>>>>")
sw.Flush()
sw.Close()
'' Open the
file to read from.
'Dim sr As
StreamReader = File.OpenText(path)
'Dim s As
String
'Do While
sr.Peek() >= 0
' s = sr.ReadLine()
' Console.WriteLine(s)
'Loop
'sr.Close()
End Function
End Class
Comments