DataGridView display turns into a mess when scrolling - vb.net
I have a windows form with a DataGridView with multiple data binding sources. The form loads correctly with the appropriate data,
but when i scroll (either scrollbar or mouse wheel), it turns into this:
If i refresh the form on new line selection, it goes back to the top of the form. I see that there is a DataGridView.Scroll event. What do i need to do with it? Is there something else that i need to change to make my form look pretty again?
thx!
EDIT
Below is the code that is run to the point. There is nothing additional that handles the way the form is drawn/redrawn, and there is no event handling on DataGridView1.scroll
Imports datagridviewautofilter
Imports System.Data.SqlClient
Public Class AssignShipDateForm
'sql datastream connection variables
Dim Conn As New System.Data.SqlClient.SqlConnection 'sql server datastream connection
Dim Cmd As New System.Data.SqlClient.SqlCommand 'sql command vars
Dim SqlQuery As String 'string var used to hold various SQL queries
Dim SqlInsertQuery As String 'sql insert query for data adapter
Dim SqlUpdateQuery As String 'sql update query for data adapter
Dim SqlDeleteQuery As String 'sql delete query for data adapter
Dim data As System.Data.SqlClient.SqlDataReader 'datareader object variable
Dim ConnString As String
Dim da As SqlDataAdapter
'MasterVars table variables
Public Vers As String = Nothing 'tally sheet version
Public Testing As Boolean = False 'tf testing
Public SendMailAcct As String = Nothing 'send email account for automated emails
Public SendMailPW As String = Nothing 'password for email account
Public SMTPUseSSL As Boolean = True ' SMTP SSL
Public SMTPAuthenticate As Integer = 0 'Authenticate SMTP
Public SMTPServer As String = Nothing 'Email Server
Public SendUsing As Integer = 0 'Send Using
Public SMTPServerPort As Integer = 0 'SMTP Email Server Port
Public TestingEmail As String = Nothing 'email account that all emails should be directed to when version is testing
Public PrePricingEmail As String = Nothing 'email account that all prod prepricing emails should be directed to
Public ImperataEmail As String = Nothing 'email account that all prod Imperata emails should be directed to (for permits etc)
Public DirectShipEmail1 As String = Nothing 'email account that all prod direct ship orders should be directed to
Public DirectShipEmail2 As String = Nothing 'email account that all prod direct ship orders should be directed to
Public DirectShipEmail3 As String = Nothing 'email account that all prod direct ship orders should be directed to
Public DirectShipEmail4 As String = Nothing 'email account that all prod direct ship orders should be directed to
'user security variables
Public EMailAddress As String = Nothing 'User's email address
Public ThePersonsName As String = Nothing 'User's name
Public Logistics As String = Nothing 'logistics module access level
'close form with changes pending variables
Dim CloseForm As New Shared_Code.SharedCode
Dim ShouldICloseForm As String = Nothing 'determiniation if the form should be closed or not
'error reporting variables
Dim ErrorReporting As New ErrorReporting.ErrorReporting
Public Shared ErrCode As String = Nothing 'error code
Public Shared ErrVar As String = Nothing 'variable that caused error
Public Shared ErrorCounter As Integer = 0 'error Counter
Public Shared ErrAct As Boolean = False 't/f fatal error
'INITIALIZE FORM
Dim FirstPass As Boolean = True 't/f switch to determine if form initialize is on a first pass or subsequent pass
'CELL VALUE CHANGED
Dim RowUpdated As Boolean = False 't/f flag to set if the row has been updated
Dim SelectedShipDate As String = Nothing 'selected ship date
Dim SelectedShipDateCounter As Integer = 0 'selected ship date PKEY for TempTable
Dim NumberOfTrucksAvailable As Integer = 0 'number of trucks available for selected Ship Date
Dim DefaultPickDateCounter As Integer = 0 'counter (PKEY) for default pick date
Dim DefaultPickDate As String = Nothing 'default pick date derived from PKEY
Dim i As Integer = 0 'counter variable for adding number of trucks available from MasterBusinessDatesTable
'SAVE BUTTON
Dim vbYN As String = Nothing 'vbyn for msgbox
Dim PickID As String = Nothing 'Pkey for logistics records
Dim DTS As DateTime = Nothing 'DTS for updates
'********************************************************************************
'* *
'*CBB00: FORM LOAD *
'* *
'********************************************************************************
Public Sub New(ByRef vers As String, ByRef testing As Boolean, ByRef SendMailAcct As String, ByRef SendMailPW As String, ByVal SMTPUseSSL As Boolean, ByVal SMTPAuthenticate As Integer, ByVal SMTPServer As String, ByVal SendUsing As Integer, ByVal SMTPServerPort As Integer, ByRef TestingEmail As String, ByRef PrePricingEmail As String, ByRef ImperataEmail As String, ByRef DirectShipEmail1 As String, ByRef DirectShipEmail2 As String, ByRef DirectShipEmail3 As String, ByRef DirectShipEmail4 As String, ByRef EMailAddress As String, ByRef ThePersonsName As String, ByRef Logistics As String)
InitializeComponent()
Me.Vers = vers
Me.Testing = testing
Me.SendMailAcct = SendMailAcct
Me.SendMailPW = SendMailPW
Me.SMTPUseSSL = SMTPUseSSL
Me.SMTPAuthenticate = SMTPAuthenticate
Me.SMTPServer = SMTPServer
Me.SendUsing = SendUsing
Me.SMTPServerPort = SMTPServerPort
Me.TestingEmail = TestingEmail
Me.PrePricingEmail = PrePricingEmail
Me.ImperataEmail = ImperataEmail
Me.DirectShipEmail1 = DirectShipEmail1
Me.DirectShipEmail2 = DirectShipEmail2
Me.DirectShipEmail3 = DirectShipEmail3
Me.DirectShipEmail4 = DirectShipEmail4
Me.EMailAddress = EMailAddress
Me.ThePersonsName = ThePersonsName
Me.Logistics = Logistics
'set connection string and form for prod vs. test
If testing = True Then
ConnString = "data Source=SQL01;Initial Catalog=TallySheetTest;Integrated Security=SSPI;"
Me.Text = "Assign Ship Dates " & vers & " TESTING"
Else
ConnString = "data Source=SQL01;Initial Catalog=TallySheet;Integrated Security=SSPI;"
Me.Text = "Assign Ship Dates " & vers
End If
For Each col As DataGridViewColumn In DataGridView1.Columns
col.HeaderCell = New DataGridViewAutoFilterColumnHeaderCell(col.HeaderCell)
Next
DataGridView1.AutoSizeRowsMode = DataGridViewAutoSizeRowsMode.AllCells
DataGridView1.DefaultCellStyle.WrapMode = DataGridViewTriState.True
Call FormInitialize()
End Sub
'********************************************************************************
'* *
'*CBC00: FORM INITIALIZE *
'* *
'********************************************************************************
Public Sub FormInitialize()
'clear Dataset
Me.TallySheetDataSet.Clear()
If FirstPass = True Then
'Do nothing
Else
'????????
End If
FirstPass = False
'Set buttons
Select Case Logistics
Case "I"
Button1.Enabled = False
Button2.Enabled = False
Case Else
Button1.Enabled = True
Button2.Enabled = False
End Select
'TODO: This line of code loads data into the 'TallySheetDataSet.TruckTypeTable' table. You can move, or remove it, as needed.
Me.TruckTypeTableTableAdapter.Fill(Me.TallySheetDataSet.TruckTypeTable)
'SPCBC0001 Check if TempTable1 is empty
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand
cmd.Connection = Conn
cmd.CommandText = "SPCBC0001"
cmd.CommandType = CommandType.StoredProcedure
Conn.Open()
data = cmd.ExecuteReader()
data.Read()
If data.HasRows = True Then
ErrCode = "CBC00-03"
ErrVar = "TempTable1"
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
vbYN = MsgBox("Would you like to clear temporary tables?", vbQuestion + vbYesNo + vbSystemModal, "")
If vbYN = vbYes Then
Call ClearTempTables()
Else
Exit Sub
End If
End If
End Using
Catch ex As SqlException
ErrCode = "CBC00-04"
ErrVar = "SPCBC0001;" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'SPCBC0002 - Check if TempTable2 is empty
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand
cmd.Connection = Conn
cmd.CommandText = "SPCBC0002"
cmd.CommandType = CommandType.StoredProcedure
Conn.Open()
data = cmd.ExecuteReader()
data.Read()
If data.HasRows = True Then
ErrCode = "CBC00-06"
ErrVar = "TempTable2"
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
vbYN = MsgBox("Would you like to clear temporary tables?", vbQuestion + vbYesNo + vbSystemModal, "")
If vbYN = vbYes Then
Call ClearTempTables()
Else
Exit Sub
End If
End If
End Using
Catch ex As SqlException
ErrCode = "CBC00-07"
ErrVar = "SPCBC0002" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'SPCBC0003 - Fill TempTable1 from MasterOrderTable, Customer, MasterLog
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand
cmd.Connection = Conn
cmd.CommandText = "SPCBC0003"
cmd.CommandType = CommandType.StoredProcedure
Conn.Open()
cmd.ExecuteNonQuery()
End Using
Catch ex As Exception
ErrCode = "CBC00-01"
ErrVar = "SPCBC0003" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'SPCBC0004 - Fill DataSet TempTable1 from TempTable1
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand("SPCBC0004", Conn)
cmd.CommandType = CommandType.StoredProcedure
Dim da As New SqlDataAdapter(cmd)
da.Fill(Me.TallySheetDataSet.TempTable1MasterOrders)
End Using
Catch ex As SqlException
ErrCode = "CBC00-05"
ErrVar = "SPCBC0004" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'handling if no rows exist
If TallySheetDataSet.TempTable1MasterOrders.Rows.Count = 0 Then
MsgBox("No open orders") '<-------------------------------- add error reporting?
Exit Sub
End If
'SPCBC0005 - Fill TempTable2 from MasterBusinessDatesTable
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand
cmd.Connection = Conn
cmd.CommandText = "SPCBC0005"
cmd.CommandType = CommandType.StoredProcedure
Conn.Open()
cmd.ExecuteNonQuery()
End Using
Catch ex As SqlException
ErrCode = "CBC00-02"
ErrVar = "SPCBC0005" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'SPCBC0006 - Fill DataSet TempTable2 from TempTable2
Try
Using Conn = New SqlConnection(ConnString)
Dim cmd As New SqlCommand("SPCBC0006", Conn)
cmd.CommandType = CommandType.StoredProcedure
Dim da As New SqlDataAdapter(cmd)
da.Fill(Me.TallySheetDataSet.TempTable2BusinessDates)
End Using
Catch ex As SqlException
ErrCode = "CBC00-08"
ErrVar = "SPCBC0006" & vbCrLf & vbCrLf & ex.Message
ErrorCounter = ErrorCounter + 1
ErrAct = ErrorReporting.YouBrokeMyProgram("", ErrCode, ErrVar, ErrorCounter, Testing, Vers, TestingEmail, SendMailAcct, SendMailPW, EMailAddress, SMTPUseSSL, SMTPAuthenticate, SMTPServer, SendUsing, SMTPServerPort)
If ErrAct = True Then
Exit Sub
End If
Finally
Conn.Close()
Conn.Dispose()
End Try
'set ALL columns read only property to true
DataGridView1.Columns(0).ReadOnly = True
DataGridView1.Columns(1).ReadOnly = True
DataGridView1.Columns(2).ReadOnly = True
DataGridView1.Columns(3).ReadOnly = True
DataGridView1.Columns(4).ReadOnly = True
DataGridView1.Columns(5).ReadOnly = True
DataGridView1.Columns(6).ReadOnly = True
DataGridView1.Columns(7).ReadOnly = True
DataGridView1.Columns(8).ReadOnly = True
DataGridView1.Columns(9).ReadOnly = True
DataGridView1.Columns(10).ReadOnly = True
DataGridView1.Columns(11).ReadOnly = True
DataGridView1.Columns(12).ReadOnly = True
DataGridView1.Columns(13).ReadOnly = True
DataGridView1.Columns(14).ReadOnly = True
DataGridView1.Columns(15).ReadOnly = True
DataGridView1.Columns(16).ReadOnly = True
DataGridView1.Columns(17).ReadOnly = True
DataGridView1.Columns(18).ReadOnly = True
DataGridView1.Columns(19).ReadOnly = True
DataGridView1.Columns(20).ReadOnly = True
DataGridView1.Columns(21).ReadOnly = True
DataGridView1.Columns(22).ReadOnly = True
DataGridView1.Columns(23).ReadOnly = True
'Refresh form
Me.Refresh()
DataGridView1.Refresh()
End Sub
EDIT
i have an empty handler for DataGridView1.DataError. I added a message box and the "Ship Date" throws an error for every value in the column, then when you scroll, it throws an error for every new "Ship Date" cell that appears. The error is for a null value being displayed in a column that doesn't accept a null value. The null value is an attempt to suppress the value '1900-01-01' from being displayed.
the display errors are caused by an error message being suppressed due to a null value being displayed in a column that doesn't accept a null value. The null value is an attempt to suppress the value '1900-01-01' from being displayed.
Related
TaskCanceledException in Google Drive APIs
it has been some days since I implemented in several PCs my Google Drive upload programme. It is developed in VB.NET console app and I can say it works out pretty good. Except that in some PCs it continues throwing the taskcanceled exception. Basically the programme works at night, where the internet traffic in the pcs should be likely to 0 and it continues trying to upload to a google folder until it succesfully do it OR the time (of an hour usually) runs out. The Exception looks like this Ex: System.AggregateException: One or more errors occured. ---> System.Threading.Tasks.TaskCanceledException: A task was canceled. --- Fine della traccia dello stack dell'eccezione interna --- in System.Threading.Tasks.Task.ThrowIfExceptional(Boolean includeTaskCanceledExceptions) in System.Threading.Tasks.Task`1.GetResultCore(Boolean waitCompletionNotification) in System.Threading.Tasks.Task`1.get_Result() in Google.Apis.Upload.ResumableUpload.Upload() in C:\Apiary\2021-09-08.15-52-39\Src\Support\Google.Apis\Upload\ResumableUpload.cs:riga 388 in TeraDriveServ.Service1.UploadFile(String FilePath) in C:\Sviluppo\TeraDriveServ\Service1.vb:row 291 ---> (Internal exception 0) System.Threading.Tasks.TaskCanceledException: A Task was canceled.<--- This is the code I use Private Sub UploadFile(FilePath As String) Dim pathDb As String = System.Configuration.ConfigurationManager.AppSettings("DB") If Service.ApplicationName <> "Google Drive VB Dot Net" Then CreateService() Dim mail As String = "" Dim destinatari As String = "" Dim TheFile As New Google.Apis.Drive.v2.Data.File() Dim nome As String = Path.GetFileName(FilePath) Dim infofile As New IO.FileInfo(FilePath) ' I get some data from the file Dim dataultimaModifica As DateTime = infofile.LastWriteTime Dim nomefileeffettivo As String = infofile.Name Dim estensione = Path.GetExtension(FilePath) 'Getting the file folder Dim folderId As String = System.Configuration.ConfigurationManager.AppSettings("CARTELLADRIVE") TheFile.Parents = New List(Of ParentReference) From {New ParentReference() With {.Id = folderId}} TheFile.Title = nome TheFile.Description = "" Dim esiste As Boolean = False ' A query to check if the file is uploaded Using con As System.Data.SQLite.SQLiteConnection = New System.Data.SQLite.SQLiteConnection("data source=" & pathDb & "databaseFile.db3") Using com As System.Data.SQLite.SQLiteCommand = New System.Data.SQLite.SQLiteCommand(con) con.Open() com.CommandText = "Select ID FROM CARICATI WHERE NOME = '" & nome & "' AND DATA='" & dataultimaModifica & "'" Using reader As System.Data.SQLite.SQLiteDataReader = com.ExecuteReader() While reader.Read() esiste = True End While con.Close() End Using End Using End Using If esiste = True Then ' already loaded Return Else Select Case estensione Case ".bak" TheFile.MimeType = "application/octet-stream" Case ".zip" TheFile.MimeType = "application/zip" 'Case ".jpeg", ".jpg" ' TheFile.MimeType = "image/ jpeg" 'Case ".txt" ' TheFile.MimeType = "text/plain" 'Case ".pdf" ' TheFile.MimeType = "application/pdf" 'Case ".xls" ' TheFile.MimeType = "application/ vnd.ms - excel" 'Case ".doc" ' TheFile.MimeType = "application/msword" 'Case ".docx" ' TheFile.MimeType = "application/vnd.openxmlformats-officedocument.wordprocessingml.document" 'Case ".xlsx" ' TheFile.MimeType = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" 'Case ".odt" ' TheFile.MimeType = "application/ vnd.oasis.opendocument.text" Case Else ' I dont like the file extension Return End Select Dim fatto As Integer = 0 ' I upload the file details in the DB Using con As System.Data.SQLite.SQLiteConnection = New System.Data.SQLite.SQLiteConnection("data source=" & pathDb & "databaseFile.db3") Using com As System.Data.SQLite.SQLiteCommand = New System.Data.SQLite.SQLiteCommand(con) con.Open() com.CommandText = "INSERT INTO CARICATI (NOME,DATA) VALUES('" & nome & "','" & dataultimaModifica & "') " com.ExecuteNonQuery() fatto = con.LastInsertRowId ' UPLOADED con.Close() End Using End Using End If Try Dim ByteArray As Byte() = System.IO.File.ReadAllBytes(FilePath) Dim Stream As New System.IO.MemoryStream(ByteArray) Dim UploadRequest As Google.Apis.Drive.v2.FilesResource.InsertMediaUpload = Service.Files.Insert(TheFile, Stream, TheFile.MimeType) logger.Debug("Oggetto creato") ' UploadRequest.ContentStream.WriteTimeout = 600000 'If contaUp = 0 Then ' UploadRequest.Service.HttpClient.Timeout = Service.HttpClient.Timeout 'End If 'contaUp = 1 logger.Debug("Starting upload: " & DateTime.Now) ' Here is where the exception points at, the Google Upload() Method UploadRequest.Upload() logger.Debug("Upload completed: " & DateTime.Now) Dim file As File = Nothing file = UploadRequest.ResponseBody If file Is Nothing Then logger.Debug("Upload failed") ' deletes the data from db to try again AnnulloCaricamento(nome, dataultimaModifica, pathDb) Else ' I send some stuff to a server logger.Debug("Cerco di fare POST") Dim testoSucc As String = System.Configuration.ConfigurationManager.AppSettings("TESTOS") POST(nomefileeffettivo, dataultimaModifica) eseguito = True End If Catch ex As Exception ' deletes the data from db to try again AnnulloCaricamento(nome, dataultimaModifica, pathDb) ''05/10/2021 End Try End Sub Thanks everyone
in vb.net error Command text was not set for the command object
I have a program in vb.net where I need data inserted into the database. When I run this code I get an error: Command text was not set for the command object Here is the code I have: Private Sub InsertRelease(strRelease As String, rowInserted As Boolean) On Error GoTo errH Dim con As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strPath As String Dim intImportRow As Integer Dim objType As String Dim strUsername, strPassword, strTable, strDatabase, strDsn, strSystem, strNewSql, sqlStr As String Dim intRecsAffected As Integer Dim boolRowInserted As Boolean strDsn = ComboBox1.Text strSystem = txtSystem.Text strUsername = txtUser.Text strPassword = txtPassword.Text If con.State <> 1 And strUsername <> "" And strPassword <> "" Then con.Open("{iSeries As ODBC Driver};System=" + strSystem + ";Dsn=" + strDsn + "; Uid=" + strUsername + "; Pwd=" + strPassword + ";") Else MessageBox.Show("Please enter the correct UserName And Password") txtUser.Focus() con = Nothing End If sqlStr = "insert into jobscopedb.ppusrfs (search_key_uf,DATA_ITEM_UF, NUMERIC_VALUE_UF) values (strRelease,'81 AB',0);" strNewSql = "" con.Execute(strNewSql, intRecsAffected) con.Close() con = Nothing boolRowInserted = (intRecsAffected > 0) If (boolRowInserted) Then MessageBox.Show("Release " + strRelease + " added") Else MessageBox.Show("Release " + strRelease + "not added") End If Exit Sub errH: MsgBox(Err.Description) con = Nothing End Sub
The following demonstrates what your code might look like using ADO.net. Pass the connection string directly to the constructor of the connection and pass the command text and connection to the constructor of the command. Open the connection and execute the command. ExecuteNonQuery returns rows affected. Always use parameters to avoid sql injection. Private Sub InsertRelease(strRelease As String) Dim intRecsAffected As Integer Dim strDsn = ComboBox1.Text Dim strSystem = txtSystem.Text Dim strUsername = txtUser.Text Dim strPassword = txtPassword.Text 'Validate Input If strUsername = "" OrElse strPassword = "" Then MessageBox.Show("Please enter the correct UserName And Password") txtUser.Focus() Exit Sub End If Using con As New OdbcConnection($"{{iSeries As ODBC Driver}};System={strSystem};Dsn={strDsn}; Uid={strUsername}; Pwd={strPassword};"), cmd As New OdbcCommand("insert into jobscopedb.ppusrfs (search_key_uf, DATA_ITEM_UF, NUMERIC_VALUE_UF) values (#Release,'81 AB',0);", con) cmd.Parameters.Add("#Release", OdbcType.VarChar).Value = strRelease con.Open() intRecsAffected = cmd.ExecuteNonQuery End Using 'Closes and disposes the connection and command even it there is an error If intRecsAffected = 1 Then MessageBox.Show("Release " + strRelease + " added") Else MessageBox.Show("Release " + strRelease + "not added") End If End Sub
Download Direct links
My program has been using: Dim DLLink1 As String DLLink1 = Trim(TextBox2.Text) Dim DownloadDirectory1 As String DownloadDirectory1 = Trim(TextBox4.Text) Try Button3.Enabled = False ' My.Computer.Network.DownloadFile(DLLink1, (DownloadDirectory1 + "/UpdatedClient.zip")) Dim HttpReq As HttpWebRequest = DirectCast(WebRequest.Create(DLLink1), HttpWebRequest) Using HttpResponse As HttpWebResponse = DirectCast(HttpReq.GetResponse(), HttpWebResponse) Using Reader As New BinaryReader(HttpResponse.GetResponseStream()) Dim RdByte As Byte() = Reader.ReadBytes(1 * 1024 * 1024 * 10) Using FStream As New FileStream(DownloadDirectory1 + "/UpdatedClient.zip", FileMode.Create) FStream.Write(RdByte, 0, RdByte.Length) End Using End Using End Using Finally MsgBox("Finished Download.") Button3.Enabled = True Label4.Visible = True I tried this previously, and it didn't work at all: My.Computer.Network.DownloadFile(DLLink1, (DownloadDirectory1 + "/UpdatedClient.zip")) The website requires you to be logged in, so I made a spare account for the program: WebBrowser1.Navigate("http://www.mpgh.net/forum/admincp/") Timer1.Start() Button2.Enabled = False Then WebBrowser1.Document.GetElementById("vb_login_username").SetAttribute("value", "AutoUpdaterAccount") WebBrowser1.Document.GetElementById("vb_login_password").SetAttribute("value", "password") Dim allelements As HtmlElementCollection = WebBrowser1.Document.All For Each webpageelement As HtmlElement In allelements If webpageelement.GetAttribute("type") = "submit" Then webpageelement.InvokeMember("click") Timer1.Stop() Label5.Text = "Authorized." Button2.Enabled = True So now you're logged into the account, on the website, but when the code above to download runs, it downloads a zip, but it's corrupted. So I opened it with notepad++ and this is what I get (Does this mean it didn't login for the download, and it only logged in with the webbrowser and they aren't linked? Or something? Like My firefox logins aren't linked with chrome?: The code is huge, it's like a HTML coding. Here is the link to a online notepad I put it on: http://shrib.com/nCOucdfL Another thing, a webbrowser can't be showing on the program, it can be on the outside not showing, like I did with the login. They also can't click the save button like on a normal web browser when a window pops up, I want it to download automatically to where they set it using a button which sets the directory as DownloadDirectory1
It must be your lucky day because today I woke up and decided that I would like to help you with your cause. I first tried to get the download to work with the web browser control but unfortunately I am sure this is not possible without extending the web browser control and we don't want to do that today. As I mentioned in the comments, the only way I really know that this is possible (without user interaction) is to log in via the HttpWebRequest method. It's pretty tricky stuff. Definitely not for beginners. Now I must admit that this isn't the cleanest, most "proper" and user-friendly code around, so if anyone wants to suggest a better way to do things, I am all ears. I suggest you test this first before you incorporate it into your existing app. Just create a new vb.net app and replace all of the code in Form1 with the code below. You will have to update the usernamehere and passwordhere strings with your real username and password. Also, the file is saving to C:\file.rar by default so you can change this path if you want. This code completely removes the need for the web browser control (unless you are using it for something else) so most likely you can remove that from your real application once you incorporate this properly: Imports System.Net Imports System.IO Imports System.Text Public Class Form1 Private Const gsUserAgent As String = "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:35.0) Gecko/20100101 Firefox/35.0" Const sUsername As String = "usernamehere" Const sPassword As String = "passwordhere" Const sMainURL As String = "http://www.mpgh.net/" Const sCheckLoginURL As String = "http://www.mpgh.net/forum/login.php?do=login" Const sDownloadURL As String = "http://www.mpgh.net/forum/attachment.php?attachmentid=266579&d=1417312178" Const sCookieLoggedInMessage As String = "mpgh_imloggedin=yes" Dim oCookieCollection As CookieCollection = Nothing Dim sSaveFile As String = "c:\file.rar" Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load StartScrape() End Sub Private Sub StartScrape() Try Dim bContinue As Boolean = True Dim sPostData(15) As String sPostData(0) = UrlEncode("vb_login_username") sPostData(1) = UrlEncode(sUsername) sPostData(2) = UrlEncode("vb_login_password") sPostData(3) = UrlEncode(sPassword) sPostData(4) = UrlEncode("vb_login_password_hint") sPostData(5) = UrlEncode("Password") sPostData(6) = UrlEncode("s") sPostData(7) = UrlEncode("") sPostData(8) = UrlEncode("securitytoken") sPostData(9) = UrlEncode("guest") sPostData(10) = UrlEncode("do") sPostData(11) = UrlEncode("login") sPostData(12) = UrlEncode("vb_login_md5password") sPostData(13) = UrlEncode("") sPostData(14) = UrlEncode("vb_login_md5password_utf") sPostData(15) = UrlEncode("") If GetMethod(sMainURL) = True Then If SetMethod(sCheckLoginURL, sPostData, sMainURL) = True Then ' Login successful If DownloadMethod(sDownloadURL, sMainURL) = True Then MessageBox.Show("File downloaded successfully") Else MessageBox.Show("Error downloading file") End If End If End If Catch ex As Exception MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End Sub Private Function GetMethod(ByVal sPage As String) As Boolean Dim req As HttpWebRequest Dim resp As HttpWebResponse Dim stw As StreamReader Dim bReturn As Boolean = True Try req = HttpWebRequest.Create(sPage) req.Method = "GET" req.AllowAutoRedirect = False req.UserAgent = gsUserAgent req.Accept = "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" req.Headers.Add("Accept-Language", "en-us,en;q=0.5") req.Headers.Add("Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7") req.Headers.Add("Keep-Alive", "300") req.KeepAlive = True resp = req.GetResponse ' Get the response from the server If req.HaveResponse Then ' Save the cookie info if applicable SaveCookies(resp.Headers("Set-Cookie")) resp = req.GetResponse ' Get the response from the server stw = New StreamReader(resp.GetResponseStream) stw.ReadToEnd() ' Read the response from the server, but we do not save it Else MessageBox.Show("No response received from host " & sPage, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) bReturn = False End If Catch exc As WebException MessageBox.Show("Network Error: " & exc.Message.ToString & " Status Code: " & exc.Status.ToString & " from " & sPage, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) bReturn = False End Try Return bReturn End Function Private Function SetMethod(ByVal sPage As String, ByVal sPostData() As String, sReferer As String) As Boolean Dim bReturn As Boolean = False Dim req As HttpWebRequest Dim resp As HttpWebResponse Dim str As StreamWriter Dim sPostDataValue As String = "" Try req = HttpWebRequest.Create(sPage) req.Method = "POST" req.UserAgent = gsUserAgent req.Accept = "application/x-shockwave-flash,text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" req.Headers.Add("Accept-Language", "en-us,en;q=0.5") req.Headers.Add("Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7") req.Referer = sReferer req.ContentType = "application/x-www-form-urlencoded" req.Headers.Add("Pragma", "no-cache") req.Headers.Add("Keep-Alive", "300") If oCookieCollection IsNot Nothing Then ' Pass cookie info from the login page req.CookieContainer = SetCookieContainer(sPage) End If str = New StreamWriter(req.GetRequestStream) If sPostData.Count Mod 2 = 0 Then ' There is an even number of post names and values For i As Int32 = 0 To sPostData.Count - 1 Step 2 ' Put the post data together into one string sPostDataValue &= sPostData(i) & "=" & sPostData(i + 1) & "&" Next i sPostDataValue = sPostDataValue.Substring(0, sPostDataValue.Length - 1) ' This will remove the extra "&" at the end that was added from the for loop above ' Post the data to the server str.Write(sPostDataValue) str.Close() ' Get the response resp = req.GetResponse If req.HaveResponse Then If resp.Headers("Set-Cookie").IndexOf(sCookieLoggedInMessage) > -1 Then ' Save the cookie info SaveCookies(resp.Headers("Set-Cookie")) bReturn = True Else MessageBox.Show("The email or password you entered are incorrect." & vbCrLf & vbCrLf & "Please try again.", "Unable to log in", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) bReturn = False End If Else ' This should probably never happen.. but if it does, we give a message MessageBox.Show("The email or password you entered are incorrect." & vbCrLf & vbCrLf & "Please try again.", "Unable to log in", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) bReturn = False End If Else ' Did not specify the correct amount of parameters so we cannot continue MessageBox.Show("POST error. Did not supply the correct amount of post data for " & sPage, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) bReturn = False End If Catch ex As Exception MessageBox.Show("POST error. " & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) bReturn = False End Try Return bReturn End Function Private Function DownloadMethod(ByVal sPage As String, sReferer As String) As Boolean Dim req As HttpWebRequest Dim bReturn As Boolean = False Try req = HttpWebRequest.Create(sPage) req.Method = "GET" req.AllowAutoRedirect = False req.UserAgent = gsUserAgent req.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" req.Headers.Add("Accept-Language", "en-US,en;q=0.5") req.Headers.Add("Accept-Encoding", "gzip, deflate") req.Headers.Add("Keep-Alive", "300") req.KeepAlive = True If oCookieCollection IsNot Nothing Then ' Set cookie info so that we continue to be logged in req.CookieContainer = SetCookieContainer(sPage) End If ' Save file to disk Using oResponse As System.Net.WebResponse = CType(req.GetResponse, System.Net.WebResponse) Using responseStream As IO.Stream = oResponse.GetResponseStream Using fs As New IO.FileStream(sSaveFile, FileMode.Create, FileAccess.Write) Dim buffer(2047) As Byte Dim read As Integer Do read = responseStream.Read(buffer, 0, buffer.Length) fs.Write(buffer, 0, read) Loop Until read = 0 responseStream.Close() fs.Flush() fs.Close() End Using responseStream.Close() End Using oResponse.Close() End Using bReturn = True Catch exc As WebException MessageBox.Show("Network Error: " & exc.Message.ToString & " Status Code: " & exc.Status.ToString & " from " & sPage, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) bReturn = False End Try Return bReturn End Function Private Function SetCookieContainer(sPage As String) As System.Net.CookieContainer Dim oCookieContainerObject As New System.Net.CookieContainer Dim oCookie As System.Net.Cookie For c As Int32 = 0 To oCookieCollection.Count - 1 If IsDate(oCookieCollection(c).Value) = True Then ' Fix dates as they seem to cause errors/problems oCookieCollection(c).Value = Format(CDate(oCookieCollection(c).Value), "dd-MMM-yyyy hh:mm:ss") End If oCookie = New System.Net.Cookie oCookie.Name = oCookieCollection(c).Name oCookie.Value = oCookieCollection(c).Value oCookie.Domain = New Uri(sPage).Host oCookie.Secure = False oCookieContainerObject.Add(oCookie) Next Return oCookieContainerObject End Function Private Sub SaveCookies(sCookieString As String) Dim sCookieStrings() As String = sCookieString.Trim.Replace(" HttpOnly,", "").Replace(" HttpOnly", "").Replace(" domain=.mpgh.net,", "").Split(";".ToCharArray()) oCookieCollection = New CookieCollection For Each sCookie As String In sCookieStrings If sCookie.Trim <> "" Then Dim sName As String = sCookie.Trim().Split("=".ToCharArray())(0) Dim sValue As String = sCookie.Trim().Split("=".ToCharArray())(1) oCookieCollection.Add(New Cookie(sName, sValue)) End If Next End Sub Private Function UrlEncode(ByRef URLText As String) As String Dim AscCode As Integer Dim EncText As String = "" Dim bStr() As Byte = Encoding.ASCII.GetBytes(URLText) Try For i As Long = 0 To UBound(bStr) AscCode = bStr(i) Select Case AscCode Case 48 To 57, 65 To 90, 97 To 122, 46, 95 EncText = EncText & Chr(AscCode) Case 32 EncText = EncText & "+" Case Else If AscCode < 16 Then EncText = EncText & "%0" & Hex(AscCode) Else EncText = EncText & "%" & Hex(AscCode) End If End Select Next i Erase bStr Catch ex As WebException MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try Return EncText End Function End Class
Failure sending email
My test case is getting failed at assert.fail(), I am not having any clue what wrong it is going and where it is getting failed. Any idea to make this test case pass Below is the test case <Test()> _ Public Sub SendFtpFailureEmailShouldPassWithProcessingInfosAndSendEmail() Dim em As EmailNotification = New EmailNotification() Try Dim pfis As ProcessingFileInfos = New ProcessingFileInfos(New FileInfo(AppSettingsReader.SchemaLocation), "Ftp") Dim pfi1 As ProcessingFileInfo = New ProcessingFileInfo(New FileInfo("Test1.xml")) pfi1.ContainsErrors = True pfi1.Message = "File Failed" pfi1.FileProcessStatus = "F" pfi1.Channel = "Ftp" pfis.Add(pfi1) Dim pfi2 As ProcessingFileInfo = New ProcessingFileInfo(New FileInfo("Test2.xml")) pfi2.ContainsErrors = True pfi2.Message = "File Failed on Bad Data" pfi2.FileProcessStatus = "F" pfi2.Channel = "Ftp" pfis.Add(pfi2) Dim result As String = em.CreateFtpFailureEmail(pfis) Assert.IsNotEmpty(result, "result is invalid") Dim emailDetails As Email = New Email() With {.Body = result, _ .FromEmail = AppSettingsReader.TPLFromEmail, _ .FromEmailName = AppSettingsReader.TPLFromEmailName, _ .SmtpHost = AppSettingsReader.SmtpHost, _ .Subject = "FTP Failure Report", _ .ToEmail = "runu.ali#cdsglobal.co.uk"} em.SendEmail(emailDetails) Catch ex As Exception Assert.Fail(ex.Message) End Try End Sub sending mail code below: Public Sub SendEmail(ByVal emailObj As Email) Try If emailObj Is Nothing Then Throw New ArgumentNullException("emailObj", "emailObj cannot be null or empty") End If Dim em As New Net.Mail.MailMessage() em.From = New MailAddress(emailObj.FromEmail, emailObj.FromEmailName) em.To.Add(New MailAddress(emailObj.ToEmail)) em.Subject = emailObj.Subject em.Body = emailObj.Body em.IsBodyHtml = True Dim SmTP As SmtpClient = New SmtpClient() SmTP.Host = emailObj.SmtpHost SmTP.Send(em) Catch ex As SmtpException Throw Catch ex As FormatException Throw End Try End Sub
Why do I get the error: System.Runtime.InteropServices.COMException?
I am using VB.NET to Create Labels in Microsoft. This is my code: Public Sub CreateLabel(ByVal StrFilter As String, ByVal Path As String) WordApp = CreateObject("Word.Application") ''Add a new document. WordDoc = WordApp.Documents.Add() Dim oConn As SqlConnection = New SqlConnection(connSTR) oConn.Open() Dim oCmd As SqlCommand Dim oDR As SqlDataReader oCmd = New SqlCommand(StrFilter, oConn) oDR = oCmd.ExecuteReader Dim intI As Integer Dim FilePath As String = "" With WordDoc.MailMerge With .Fields Do While oDR.Read For intI = 0 To oDR.FieldCount - 1 .Add(WordApp.Selection.Range, oDR.Item(intI)) Next Loop End With Dim objAutoText As Word.AutoTextEntry = WordApp.NormalTemplate.AutoTextEntries.Add("MyLabelLayout", WordDoc.Content) WordDoc.Content.Delete() .MainDocumentType = Word.WdMailMergeMainDocType.wdMailingLabels FilePath = CreateSource(StrFilter) .OpenDataSource(FilePath) Dim NewLabel As Word.CustomLabel = WordApp.MailingLabel.CustomLabels.Add("MyLabel", False) WordApp.MailingLabel.CreateNewDocument(Name:="MyLabel", Address:="", AutoText:="MyLabelLayout") objAutoText.Delete() .Destination = Word.WdMailMergeDestination.wdSendToNewDocument WordApp.Visible = True .Execute() End With oConn.Close() WordDoc.Close() End Sub Private Function CreateSource(ByVal StrFilter As String) As String Dim CnnUser As SqlConnection = New SqlConnection(connSTR) Dim sw As StreamWriter = File.CreateText("C:\Mail.Txt") Dim Path As String = "C:\Mail.Txt" Dim StrHeader As String = "" Try Dim SelectCMD As SqlCommand = New SqlCommand(StrFilter, CnnUser) Dim oDR As SqlDataReader Dim IntI As Integer SelectCMD.CommandType = CommandType.Text CnnUser.Open() oDR = SelectCMD.ExecuteReader For IntI = 0 To oDR.FieldCount - 1 StrHeader &= oDR.GetName(IntI) & " ," Next StrHeader = Mid(StrHeader, 1, Len(StrHeader) - 2) sw.WriteLine(StrHeader) sw.Flush() sw.Close() StrHeader = "" Do While oDR.Read For IntJ As Integer = 0 To oDR.FieldCount - 1 StrHeader &= oDR.GetString(IntJ) & " ," Next Loop StrHeader = Mid(StrHeader, 1, Len(StrHeader) - 2) sw = File.AppendText(Path) sw.WriteLine(StrHeader) CnnUser.Close() sw.Flush() sw.Close() Catch ex As Exception MessageBox.Show(ex.Message, "TempID", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try Return Path End Function Now when I am running the program I am getting this error. I tried hard but not able to locate what could be the problem the error is: System.Runtime.InteropServices.COMException -->Horizontal and vertical pitch must be greater than or equal to the label width and height, respectively. Even though I tried to set the Horizontal and vertical pitch programatically it gives same error.
Make sure that you have a default printer set up for the user account that the application runs under. Might not be relevant but I have had various unusual problems following that omission.
Did you install the Office Primary Interop Assemblies? (Appropriately abbreviated to PIA) Try this