Why do I get the error: System.Runtime.InteropServices.COMException? - vb.net

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

Related

VB.net Crystal report export to html and send as html mail body using outlook

I am trying to send contents of a crystal report as email body using outlook application.
Here is my code in VB.net
Imports outlook = Microsoft.Office.Interop.Outlook
Dim a As String = something.ConnectionString
Dim cryRpt As ReportDocument
Dim username As String = a.Split("=")(3).Split(";")(0) 'get username
Dim password As String = a.Split("=")(4).Split(";")(0) 'get password
cryRpt = New ReportDocument()
Dim Path As String = Application.StartupPath
Dim svPath As String = Application.StartupPath & "\PDF"
If Not Directory.Exists(svPath) Then
Directory.CreateDirectory(svPath)
End If
cryRpt.Load(Path & "\Reports\dr.rpt")
CrystalReportViewer1.ReportSource = cryRpt
cryRpt.SetDatabaseLogon(username, password)
CrystalReportViewer1.Refresh()
Dim myExportOptions As ExportOptions
myExportOptions = cryRpt.ExportOptions
myExportOptions.ExportDestinationType = ExportDestinationType.DiskFile
myExportOptions.ExportFormatType = ExportFormatType.HTML40 'i tried HTML32 also
Dim html40FormatOptions As HTMLFormatOptions = New HTMLFormatOptions()
html40FormatOptions.HTMLBaseFolderName = svPath
html40FormatOptions.HTMLFileName = "dr.htm"
html40FormatOptions.HTMLEnableSeparatedPages = False
html40FormatOptions.HTMLHasPageNavigator = False
html40FormatOptions.UsePageRange = False
myExportOptions.FormatOptions = html40FormatOptions
cryRpt.Export()
Try
Dim oApp As outlook.Application
oApp = New outlook.Application
Dim oMsg As outlook.MailItem
oMsg = oApp.CreateItem(outlook.OlItemType.olMailItem)
oMsg.Subject = txtSubject.Text
oMsg.BodyFormat = outlook.OlBodyFormat.olFormatHTML
oMsg.HTMLBody = ""
oMsg.HTMLBody = getFileAsString(svPath & "\PoPrt\QuotPrt.html")
oMsg.To = txtEmailId.Text
Dim ccArray As New List(Of String)({txtCC1.Text, txtCC2.Text, txtCC3.Text})
Dim cclis As String = String.Join(",", ccArray.Where(Function(ss) Not String.IsNullOrEmpty(ss)))
oMsg.CC = cclis
oMsg.Display(True)
Catch ex As Exception
MsgBox("Something went wrong", vbExclamation)
End Try
SvFormPanel3.Visible = False
the function
Private Function getFileAsString(ByVal file As String) As String
Dim reader As System.IO.FileStream
Try
reader = New System.IO.FileStream(file, IO.FileMode.Open)
Catch e As Exception
MsgBox("Something went wrong. " + e.Message, vbInformation)
End Try
Dim resultString As String = ""
Dim b(1024) As Byte
Dim temp As UTF8Encoding = New UTF8Encoding(True)
Do While reader.Read(b, 0, b.Length) > 0
resultString = resultString & temp.GetString(b)
Array.Clear(b, 0, b.Length)
Loop
reader.Close()
Return resultString
End Function
The report will get exported to the specified location as html. And when we manually open that html file it displays perfectly with border lines and all.
But when its getting added as html body of outlook application, the formatting will be gone, and looks scattered.
can anyone help
Did you try this?
Open outlook, go to, File>Options>Mail
go to section MessageFormat and untick "Reduce message size by removing format..."
I have solved the issue by exporting it into PDF and then convert to Image and embed in email body.

how to search through sub folders vb.net with a windows service?

I'm having problems with my code, the idea is to find a file in a folder but this is a remote folder and it has many sub folders if it doesn't find it then it should look for it in another folder, but it doesn't seem to work could anyone help me please? thanks for any help :).
Dim dt2 As New System.Data.DataTable()
Dim query2 As String = "SELECT juzgado, rutaPDF FROM mismoCorreo WHERE DATEPART(DAY, BirthDate) = #Day AND DATEPART(MONTH, BirthDate) = #Month"
Dim constr2 As String = ConfigurationManager.ConnectionStrings("constr").ConnectionString
Using con As New SqlConnection(constr2)
Using cmd As New SqlCommand(query2)
cmd.Connection = con
cmd.Parameters.AddWithValue("#Day", DateTime.Today.Day)
cmd.Parameters.AddWithValue("#Month", DateTime.Today.Month)
Using sda As New SqlDataAdapter(cmd)
sda.Fill(dt2)
End Using
End Using
End Using
For Each row As DataRow In dt2.Rows
Dim juzgado As String = row("juzgado").ToString()
Dim nombre_archivo As String = row("rutaPDF").ToString()
If (juzgado = "PRIMERO DE LO FAMILIAR") Then
enviar = "\\172.16.20.101\SisInt\Juzgados\acuerdos\J92016SEM2" & "\" & nombre_archivo & ".docx"
ElseIf (juzgado = "SEGUNDO DE LO FAMILIAR") Then
enviar = "\\172.16.20.101\SisInt\Juzgados\acuerdos\J102016SEM2" & "\" & nombre_archivo & ".docx"
End If
Next
For index = 0 To ListaArchivos.Count - 1
Dim wordApplication = New Microsoft.Office.Interop.Word.Application()
Dim wordDocument As Document = Nothing
Dim paramSourceDocPath As String = ListaArchivos.Item(index)
Dim paramExportFilePath As String = "\\172.16.20.101\SisInt\Convertidos" + "\" + ListaNombres.Item(index) + ".pdf"
Dim paramExportFormat As WdExportFormat =
WdExportFormat.wdExportFormatPDF
Dim paramOpenAfterExport As Boolean = False
Dim paramExportOptimizeFor As WdExportOptimizeFor =
WdExportOptimizeFor.wdExportOptimizeForPrint
Dim paramExportRange As WdExportRange =
WdExportRange.wdExportAllDocument
Dim paramStartPage As Int32 = 0
Dim paramEndPage As Int32 = 0
Dim paramExportItem As WdExportItem =
WdExportItem.wdExportDocumentContent
Dim paramIncludeDocProps As Boolean = True
Dim paramKeepIRM As Boolean = True
Dim paramCreateBookmarks As WdExportCreateBookmarks =
WdExportCreateBookmarks.wdExportCreateWordBookmarks
Dim paramDocStructureTags As Boolean = True
Dim paramBitmapMissingFonts As Boolean = True
Dim paramUseISO19005_1 As Boolean = False
Try
'Abrir documento basados en el que selecciono
wordDocument = wordApplication.Documents.Open(paramSourceDocPath)
' Exportar al formato deseado
If Not wordDocument Is Nothing Then
wordDocument.ExportAsFixedFormat(paramExportFilePath,
paramExportFormat, paramOpenAfterExport,
paramExportOptimizeFor, paramExportRange, paramStartPage,
paramEndPage, paramExportItem, paramIncludeDocProps,
paramKeepIRM, paramCreateBookmarks,
paramDocStructureTags, paramBitmapMissingFonts,
paramUseISO19005_1)
End If
Catch ex As Exception
'MessageBox.Show(ex.Message)
'Registro en base de datos fecha hora y ex.message
Finally
If Not wordDocument Is Nothing Then
wordDocument.Close(False)
wordDocument = Nothing
End If
If Not wordApplication Is Nothing Then
wordApplication.Quit()
wordApplication = Nothing
End If
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
GC.WaitForPendingFinalizers()
End Try
Next

import from excel error in datagridview vb.net 2010

i am importing excel file in datagridview below is my code
'ofdImport.Filter = "Excel Files (*.xls)|*.xls"
ofdImport.FileName = ""
If ofdImport.ShowDialog(Me) = Windows.Forms.DialogResult.Cancel Then
Exit Sub
End If
txtPath.Text = ofdImport.FileName
If txtPath.Text <> "" Then
chkItemList.Visible = True
dgvImportData.Visible = True
pnlDataMsg.Visible = False
dgvImportData.Columns.Clear()
chkItemList.Items.Clear()
Try
Dim conExcel As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & txtPath.Text & " '; Extended Properties=Excel 8.0;")
Dim excelSelect As New OleDbCommand
Dim excelAdp As New OleDbDataAdapter
Dim excelSchemaDt As DataTable
Dim dset As New DataSet
If conExcel.State Then conExcel.Close()
conExcel.Open()
excelSelect.Connection = conExcel
excelSchemaDt = conExcel.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, Nothing)
Dim sheetName As String = excelSchemaDt.Rows(0)("TABLE_NAME").ToString()
excelSelect.CommandText = "select * from [" & sheetName & "] "
excelAdp.SelectCommand = excelSelect
excelAdp.TableMappings.Add("Table", "TestTable")
excelAdp.Fill(dset)
dgvImportData.DataSource = dset.Tables(0)
Dim i As Integer
Dim q(dgvImportData.Columns.Count()) As String
For i = 0 To (dgvImportData.Columns.Count - 1)
q(i) = (dgvImportData.Columns(i).HeaderText.ToString())
Next i
conExcel.Close()
i = 0
Dim a As String = ""
'Dim q(frmImportWizard.gridImport.Columns.Count()) As String
For i = 0 To dgvImportData.Columns.Count - 1
a = dgvImportData.Columns(i).HeaderText.ToString()
'CheckedListBox1.Items.Add(a)
chkItemList.Items.Add(a)
Next i
chkAll.Visible = True
chkAll.Checked = False
lblColumnData.Visible = True
Catch ex As Exception
'MsgBox(ex.Message, MsgBoxStyle.Information)
End Try
End If
excel file contains phone nos for eg "9874532146/8456663225" in one colms and also i have "98455566966" in same colmns
the problem here is my code is not reading the phone numbers
without "/" its going blank in grid
please help
replaced connection string
Dim conExcel As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source='" & txtPath.Text & "';Extended Properties=""Excel 8.0;HDR=YES;IMEX=1""")

Sharepoont 2010 webpart vb.net Listbox SelectIndexChanged and errors

So let start I am new to coding widgets and in general. I had originally coded this in vb for asp pages and it work fine. Now converting over to a SharePoint 2010 webpart (not visual webpart).
The project is List box 1 has the user groups that they manage, List box 2 has the users in said group, List box 3 has all user not in List box 2
I am sure there lots of this that should be fix. Like not putting in admin login to get the data.
But the problem I have is: if select a group it will display the appropriate data but select a second group or select a user to add; same error.
Error:
"Failed to load viewstate. The control tree into which viewstate is being loaded must match the control tree that was used to save viewstate during the previous request."
Also still trying to figure out how to do the button to add a user.
Need some serious help please. I know part of the post back just having a hard time finding resources.
Below is the code:
Imports System
Imports System.ComponentModel
Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports Microsoft.SharePoint
Imports Microsoft.SharePoint.WebControls
Imports ActiveDs
Imports System.DirectoryServices
Imports System.Data
Imports ADODB
Imports System.Runtime.InteropServices
<ToolboxItemAttribute(False)> _
Public Class Groups
Inherits System.Web.UI.WebControls.WebParts.WebPart
Private LBgrp As ListBox
Private LBgrpmem As ListBox
Private LBaddgrp As ListBox
Private btnadd As Button
Protected Overrides Sub CreateChildControls()
Me.LBgrpmem = New ListBox
Me.LBgrpmem.AutoPostBack = True
Me.LBgrpmem.DataValueField = "sAMAccountName"
Me.LBgrpmem.DataTextField = "displayName"
Me.LBgrpmem.DataBind()
Me.LBgrpmem.Rows = 8
Me.LBgrpmem.Width = 170
Me.LBgrpmem.Height = 350
Me.LBgrpmem.Items.Insert(0, New ListItem("-- Current Members --"))
Me.Controls.Add(LBgrpmem)
Me.LBaddgrp = New ListBox
Me.LBaddgrp.AutoPostBack = True
Me.LBaddgrp.DataTextField = "displayName"
Me.LBaddgrp.DataValueField = "sAMAccountName"
Me.LBaddgrp.DataBind()
Me.LBaddgrp.Items.Insert(0, New ListItem("-- Add Users --"))
Me.LBaddgrp.Width = 170
Me.LBaddgrp.Height = 350
AddHandler LBaddgrp.SelectedIndexChanged, New EventHandler(AddressOf DLAdd_SelectedIndexChanged)
Me.Controls.Add(LBaddgrp)
Me.btnadd = New Button()
' AddHandler Me.btnadd.Click, New EventHandler(AddressOf Click_btnadd)
Me.btnadd.Text = "Add User"
Me.Controls.Add(btnadd)
End Sub
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Dim oCon As New ADODB.Connection
Dim oRecordSet As New ADODB.Recordset
Dim oCmd As New ADODB.Command
Dim sFullUser As String = Environment.UserName
Dim sProperties = "name,ADsPath,description,member,memberof,managedObjects"
Dim sGroup = "*"
Dim aMember
Dim iCount
oCon.ToString()
oCmd.ToString()
sFullUser.ToString()
sProperties.ToString()
sDomainADsPath.ToString()
oCon.Provider = "ADsDSOObject"
oCon.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd.ActiveConnection = oCon
oCmd.CommandText = "<" & sDomainADsPath & ">;(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sFullUser & "));" & sProperties & ";subtree"
oRecordSet = oCmd.Execute
Dim de As DirectoryServices.DirectoryEntry = New DirectoryServices.DirectoryEntry(sDomainADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim i As Integer = 0
Dim sl As SortedList = New SortedList(New CaseInsensitiveComparer)
de.ToString()
While Not oRecordSet.EOF
aMember = oRecordSet.Fields("managedObjects").Value
If Not IsDBNull(aMember) Then
For iCount = 0 To UBound(aMember)
Dim groupDN As String = ("distinguishedName=" & aMember(iCount))
Dim src As DirectoryServices.DirectorySearcher = New DirectoryServices.DirectorySearcher("(&(objectCategory=Group)(" & groupDN & "))")
src.SearchRoot = de
src.SearchScope = DirectoryServices.SearchScope.Subtree
For Each res As DirectoryServices.SearchResult In src.FindAll
sl.Add(res.Properties("name")(0).ToString, i)
i += 1
Next
Next
End If
oRecordSet.MoveNext()
End While
Me.LBgrp = New ListBox
Me.LBgrp.AutoPostBack = True
Me.LBgrp.DataSource = sl
Me.LBgrp.DataTextField = "key"
Me.LBgrp.DataValueField = "value"
Me.LBgrp.DataBind()
Me.LBgrp.Items.Insert(0, New ListItem("-- Groups --"))
Me.Controls.Add(LBgrp)
Me.LBgrp.SelectedIndex = 0
AddHandler LBgrp.SelectedIndexChanged, New EventHandler(AddressOf LBgrp_SelectedIndexChanged)
LBgrp.SelectedItem.ToString()
End Sub
Protected Sub LBgrp_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) 'Handles LBgrp.SelectedIndexChanged
Dim strQuery As String = "" & LBgrp.SelectedItem.Text.ToString() & "'"
'LBgrpmem.Items.Clear()
Dim oRootDSE2 = GetObject("LDAP://RootDSE")
Dim sDomainADsPath2 = "LDAP://" & oRootDSE2.Get("defaultNamingContext")
Dim oCon2 As New ADODB.Connection
Dim oRecordSet2 As New ADODB.Recordset
Dim sFullUser2 As String = Environment.UserName
Dim oCmd2 As New ADODB.Command
Dim sProperties2 = "name,ADsPath,description,member,memberof,managedObjects"
Dim grpADsPath2
Dim grpdsplynm2
oRootDSE2 = Nothing
oCon2.Provider = "ADsDSOObject"
oCon2.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd2.ActiveConnection = oCon2
oCmd2.CommandText = "<" & sDomainADsPath2 & ">;(&(objectCategory=group)(objectClass=group)(CN=" & LBgrp.SelectedItem.Text & "));" & sProperties2 & ";subtree"
oRecordSet2 = oCmd2.Execute
While oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
grpADsPath2.ToString()
grpdsplynm2 = grpADsPath2.remove(0, 7)
grpdsplynm2.ToString()
oRecordSet2.MoveNext()
End While
While Not oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
grpADsPath2.ToString()
grpdsplynm2 = grpADsPath2.remove(0, 7)
grpdsplynm2.ToString()
oRecordSet2.MoveNext()
End While
Dim groupDN2 As String = "" & grpdsplynm2 & ""
Dim filter As String = [String].Format("(&(objectClass=user)(objectCategory=person)(memberOf={0}))", groupDN2)
Me.LBgrpmem.AutoPostBack = True
Me.LBgrpmem.DataSource = FindUsers(filter, New String() {"sAMAccountName", "displayName"}, sDomainADsPath2, True)
Me.LBgrpmem.DataValueField = "sAMAccountName"
Me.LBgrpmem.DataTextField = "displayName"
Me.LBgrpmem.DataBind()
Me.LBgrpmem.Items.Insert(0, New ListItem("-- Current Members --"))
Me.Controls.Add(LBgrpmem)
Dim usrDN As String = "" & grpdsplynm2 & ""
usrDN.ToString()
Dim usrfilter As String = [String].Format("(&(objectClass=user)(objectCategory=person)(!memberOf={0}))", groupDN2)
Me.LBaddgrp.AutoPostBack = True
Me.LBaddgrp.DataSource = FindUsers(usrfilter, New String() {"sAMAccountName", "displayName"}, sDomainADsPath2, True)
Me.LBaddgrp.DataTextField = "displayName"
Me.LBaddgrp.DataValueField = "sAMAccountName"
Me.LBaddgrp.DataBind()
Me.LBaddgrp.Items.Insert(0, New ListItem("-- Add Users --"))
'AddHandler LBaddgrp.SelectedIndexChanged, New EventHandler(AddressOf DLAdd_SelectedIndexChanged)
Me.Controls.Add(LBaddgrp)
End Sub
Public Function FindUsers(ByVal sFilter As String, ByVal columns() As String, ByVal path As String, ByVal useCached As Boolean) As Data.DataSet
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
'try to retrieve from cache first
Dim context As HttpContext = HttpContext.Current
Dim userDS As Data.DataSet = CType(context.Cache(sFilter), Data.DataSet)
If userDS Is Nothing Or Not useCached Then
'setup the searching entries
Dim deParent As New DirectoryServices.DirectoryEntry(sDomainADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim ds As New DirectoryServices.DirectorySearcher(deParent, sFilter, columns, DirectoryServices.SearchScope.Subtree)
ds.PageSize = 1000
ds.Sort.PropertyName = "displayName" 'sort option
Using (deParent)
userDS = New Data.DataSet("userDS")
Dim dt As Data.DataTable = userDS.Tables.Add("users")
Dim dr As Data.DataRow
'add each parameter as a column
Dim prop As String
For Each prop In columns
dt.Columns.Add(prop, GetType(String))
Next prop
Dim src As DirectoryServices.SearchResultCollection = ds.FindAll
Try
Dim sr As DirectoryServices.SearchResult
For Each sr In src
dr = dt.NewRow()
For Each prop In columns
If sr.Properties.Contains(prop) Then
dr(prop) = sr.Properties(prop)(0)
End If
Next prop
dt.Rows.Add(dr)
Next sr
Finally
src.Dispose()
End Try
End Using
'cache it for later, with sliding window
context.Cache.Insert(sFilter, userDS, Nothing, DateTime.MaxValue, TimeSpan.FromSeconds(10))
End If
Return userDS
End Function 'FindUsers
Protected Sub DLAdd_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) 'Handles Click_btnadd
Dim oRootDSE = GetObject("LDAP://RootDSE")
Dim sDomainADsPath = "LDAP://" & oRootDSE.Get("defaultNamingContext")
Dim oCon As New ADODB.Connection
Dim oRecordSet As New ADODB.Recordset
Dim oRcrdSet As New ADODB.Recordset
Dim oCmd As New ADODB.Command
Dim oCmd1 As New ADODB.Command
Dim sGroup = "*"
Dim sProperties = "name,ADsPath,description,member,memberof,proxyAddresses"
Dim grpADsPath
Dim grpdsplynm
Dim addusrADsPath
Dim addusrname
oRootDSE = Nothing
oCon.Provider = "ADsDSOObject"
oCon.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd.ActiveConnection = oCon
oCmd1.ActiveConnection = oCon
oCmd.CommandText = "<" & sDomainADsPath & ">;(&(objectClass=group)(cn=" & LBgrp.SelectedItem.Text & "));" & sProperties & ";subtree"
oRecordSet = oCmd.Execute
'Group Query
While Not oRecordSet.EOF
grpADsPath = oRecordSet.Fields("ADsPath").Value
grpdsplynm = oRecordSet.Fields("name").Value
oRecordSet.MoveNext()
End While
oCmd1.CommandText = "<" & sDomainADsPath & ">;(&(objectCategory=person)(objectClass=user)(cn=" & LBaddgrp.SelectedItem.Text & "));" & sProperties & ";subtree"
oRcrdSet = oCmd1.Execute
'User query
While Not oRcrdSet.EOF
addusrADsPath = oRcrdSet.Fields("ADsPath").Value
addusrname = oRcrdSet.Fields("name").Value
oRcrdSet.MoveNext()
End While
' Bind directly to the group
'
Dim oRootDSE2 = GetObject("LDAP://RootDSE")
Dim sDomainADsPath2 = "LDAP://" & oRootDSE2.Get("defaultNamingContext")
Dim oCon2 As New ADODB.Connection
Dim oRecordSet2 As New ADODB.Recordset
Dim sFullUser2 As String = Environment.UserName
'Dim sFullUser2 = Request.ServerVariables("LOGON_USER")
'Dim sUser2 = Split(sFullUser2, "\", -1)
Dim oCmd2 As New ADODB.Command
Dim sProperties2 = "name,ADsPath,description,member,memberof,managedObjects"
Dim grpADsPath2
oRootDSE2 = Nothing
oCon2.Provider = "ADsDSOObject"
oCon2.Open("ADProvider", "ADMINUSER#Domain.com", "ADMINPASSWORD")
oCmd2.ActiveConnection = oCon2
oCmd2.CommandText = "<" & sDomainADsPath2 & ">;(&(objectCategory=group)(objectClass=group)(CN=" & LBgrp.SelectedItem.Text & "));" & sProperties2 & ";subtree"
oRecordSet2 = oCmd2.Execute
While Not oRecordSet2.EOF
grpADsPath2 = oRecordSet2.Fields("ADsPath").Value
oRecordSet2.MoveNext()
End While
Dim group As New DirectoryServices.DirectoryEntry("" & grpADsPath2 & "", "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim user As New DirectoryServices.DirectoryEntry(addusrADsPath, "ADMINUSER#Domain.com", "ADMINPASSWORD", DirectoryServices.AuthenticationTypes.Secure)
Dim isMember As Boolean = Convert.ToBoolean(group.Invoke("IsMember", New Object() {user.Path}))
If isMember Then
'
' TO CREATE ERROR MESSAGE
Else
' Add the user to the group by invoking the Add method
'
group.Invoke("Add", New Object() {user.Path})
End If
If Not IsNothing(user) Then
user.Dispose()
End If
If Not IsNothing(group) Then
group.Dispose()
End If
Console.ReadLine()
If (Err.Number <> 0) Then
' TO CREATE ERROR MESSAGE
Else
' TO CREATE SUCCESS MESSAGE
End If
End Sub
Protected Overrides Sub Render(writer As System.Web.UI.HtmlTextWriter)
LBgrp.RenderControl(writer)
LBgrpmem.RenderControl(writer)
LBaddgrp.RenderControl(writer)
btnadd.RenderControl(writer)
End Sub
End Class
if memory serves me correctly, Page_Load event is firing on a postback too, where you are trying to create another instance of your drop down. So the system is trying to recreate the state of ListBox from ViewState but it is not the same ListBox, because you have just recreated it. So it barks.
To avoid it, in the page_load only create "parent" drop down if it's not postback. i.e.
Begin Page_Load()
If !Page.IsPostBack() Then
'load code here
End If
End Page_Load
Also there's no need to write
Me.LBgrpmem = New ListBox
as it is already created. Changing the datasource is usually enuff.

vb.net use string as a previously created object instance

Not sure exactly what I need to do to make this work, so my description may be lacking at first. Essentially I am writing a program launcher that recreates itself each time on load. It pulls the data regarding the tabs and buttons from an SQLite database and builds itself dynamically at run time. I get my problem when I pass the tab name through to the function that creates the buttons. I need the name to pull the right set of buttons from the database and I then tried to use the name to place the buttons on the right tab when I create them, but the debugger calls it a null reference because it doesn't point correctly to the tabpage that I'm trying to make it point to (at least that is what I'm guessing). Any ideas on how to make this work right?
Private Sub CreateTabs()
Dim SQLconnect As New SQLite.SQLiteConnection()
Dim SQLcommand As SQLiteCommand
SQLconnect.ConnectionString = "Data Source=" & sPath & "\dock.db;"
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = "SELECT title FROM tabs"
Dim SQLreader As SQLiteDataReader = SQLcommand.ExecuteReader()
Dim Tabs(25) As String
Dim c As Integer = 1
While SQLreader.Read()
Tabs(c) = SQLreader(0)
c = c + 1
End While
SQLcommand.Dispose()
SQLconnect.Close()
For i = 1 To UBound(Tabs)
If Tabs(i) <> "" Then
Launcher.TabPages.Add(Tabs(i))
CreateButtons(Tabs(i))
End If
Next
End Sub
Private Sub CreateButtons(ByVal tab)
Dim SQLconnect As New SQLite.SQLiteConnection()
Dim SQLcommand As SQLiteCommand
SQLconnect.ConnectionString = "Data Source=" & sPath & "\dock.db;"
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = "SELECT id,name,path FROM buttons WHERE tab = '" & tab & "'"
Dim SQLreader As SQLiteDataReader = SQLcommand.ExecuteReader()
While SQLreader.Read()
For i = 1 To 9
Dim NewButton(i) As Button
If Not SQLreader(2) Is System.DBNull.Value Then
Dim myIcon As System.Drawing.Icon = Icon.ExtractAssociatedIcon(SQLreader(2))
End If
Dim toolTip1 As ToolTip = New System.Windows.Forms.ToolTip(Me.components)
Me.Controls(tab).tabpages.add(NewButton(i)) '<--this causes my problem
'NewButton(i).Width = 32
'NewButton(i).Height = 32
'NewButton(i).Text = i
'NewButton(i).Image = myIcon.ToBitmap
'If Not SQLreader(1) Is System.DBNull.Value Then
'toolTip1.SetToolTip(NewButton(i), SQLreader(1))
'toolTip1.Active = True
'End If
Next
End While
SQLcommand.Dispose()
SQLconnect.Close()
End Sub
I think you've got two problems here:
You're trying to find the tab control by the tab name. You should instead find the tab control itself (or pass it in) and find the name of the tab inside that control. Otherwise you're trying to add a button to a collection of tab pages, instead of to a specific tab.
You're never actually creating a new button. You're creating an array of buttons for every iteration of the loop, but not a new actual Button object. Admittedly that doesn't jibe with your suspicion that it's due to tab pages, but it's certainly a problem...
I suspect you want this as your loop (where tabControl is the TabControl passed in):
While SQLreader.Read()
For i = 1 To 9
If Not SQLreader(2) Is System.DBNull.Value Then
Dim myIcon As Icon = Icon.ExtractAssociatedIcon(SQLreader(2))
End If
Dim toolTip1 As ToolTip = New ToolTip(Me.components)
Dim NewButton As Button = New Button
NewButton.Width = 32
NewButton.Height = 32
NewButton.Text = i
NewButton.Image = myIcon.ToBitmap
tabControl.TabPages(tab).Controls.Add(NewButton)
If Not SQLreader(1) Is System.DBNull.Value Then
toolTip1.SetToolTip(NewButton, SQLreader(1))
toolTip1.Active = True
End If
Next
End While
Hopefully that's right - my VB.NET isn't great...
I'm surprised your original code compiled though - do you have Option Strict on?
You should also use a Using statement for your command and connection so they get disposed even when an exception occurs.
Thanks for the help, but I found my answer. Apparently I just needed to reference the index of the tab like so:
Private Sub CreateTabs()
Dim SQLconnect As New SQLite.SQLiteConnection()
Dim SQLcommand As SQLiteCommand
SQLconnect.ConnectionString = "Data Source=" & sPath & "\dock.db;"
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = "SELECT title FROM tabs"
Dim SQLreader As SQLiteDataReader = SQLcommand.ExecuteReader()
Dim Tabs(25) As String
Dim c As Integer = 1
While SQLreader.Read()
Tabs(c) = SQLreader(0)
c = c + 1
End While
SQLcommand.Dispose()
SQLconnect.Close()
For i = 1 To UBound(Tabs)
If Tabs(i) <> "" Then
Launcher.TabPages.Add(Tabs(i))
CreateButtons(Tabs(i), i - 1)
End If
Next
End Sub
Private Sub CreateButtons(ByVal tab, ByVal TabIndex)
Dim SQLconnect As New SQLite.SQLiteConnection()
Dim SQLcommand As SQLiteCommand
SQLconnect.ConnectionString = "Data Source=" & sPath & "\dock.db;"
SQLconnect.Open()
SQLcommand = SQLconnect.CreateCommand
SQLcommand.CommandText = "SELECT id,name,path FROM buttons WHERE tab = '" & tab & "'"
Dim SQLreader As SQLiteDataReader = SQLcommand.ExecuteReader()
While SQLreader.Read()
For i = 1 To 9
Dim NewButton As New Button
Launcher.TabPages.Item(TabIndex).Controls.add(NewButton)
NewButton.Width = 32
NewButton.Height = 32
NewButton.Location = New Point(10 + (SQLreader(0) * 32) + 10, 10)
NewButton.Text = SQLreader(0)
If Not SQLreader(2) Is System.DBNull.Value Then
Dim toolTip1 As ToolTip = New System.Windows.Forms.ToolTip(Me.components)
Dim myIcon As System.Drawing.Icon = Icon.ExtractAssociatedIcon(SQLreader(2))
NewButton.Image = myIcon.ToBitmap
toolTip1.SetToolTip(NewButton, SQLreader(1))
toolTip1.Active = True
End If
Next
End While
SQLcommand.Dispose()
SQLconnect.Close()
End Sub