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""")
Related
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
This is a bit of a weird question, and apologies for the vast amount of code the question contains, but, I've been given somebody else's project to maintain, and the user has come to me with an error. There is a button which opens the InputBox, seen below.
The form is used to enter a path of a file to import. If the user enters no path, or an incorrect one, an error is displayed - fine. Now, the problem is, is that if the user presses the 'Cancel' button or the x in the top right to close the form, it also returns the same error, saying that the path cannot be found.
After looking through the following code, I can't work out how to make it so that the error is not displayed when pressing the x or Cancel, so can anybody help me out at all?
Private Sub btnImport_Click(sender As Object, e As EventArgs) Handles btnImport.Click
Try
Dim importbox As String = InputBox("Input path", "Import", "")
Dim fi As New FileInfo(importbox)
Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Text;Data Source=" & fi.DirectoryName
Dim conn As New OleDbConnection(connectionString)
conn.Open()
Dim add1 As String = ""
Dim add2 As String = ""
Dim add3 As String = ""
Dim add4 As String = ""
Dim add5 As String = ""
Dim postcode As String = ""
Dim telephone As String = ""
Dim fax As String = ""
Dim email As String = ""
Dim customercode As String = ""
Dim customername As String = ""
Dim webpage As String = ""
Dim mobile As String = ""
Dim headerTable As DataTable = ugHeaders.DataSource
Dim csvArray(headerTable.Rows.Count) As String
Dim i As Integer = 0
For Each dr As DataRow In headerTable.Rows
csvArray(i) = dr.Item("CSVName")
Next
For Each dr As DataRow In headerTable.Rows
Select Case dr.Item("DBName").ToString.Trim
Case "Add1"
add1 = dr.Item("CSVName")
Case "Add2"
add2 = dr.Item("CSVName")
Case "Add3"
add3 = dr.Item("CSVName")
Case "Add4"
add4 = dr.Item("CSVName")
Case "Add5"
add5 = dr.Item("CSVName")
Case "PostCode"
postcode = dr.Item("CSVName")
Case "Telephone"
telephone = dr.Item("CSVName")
Case "Fax"
fax = dr.Item("CSVName")
Case "Email"
email = dr.Item("CSVName")
Case "Customer_Name"
customername = dr.Item("CSVName")
Case "Customer_Code"
customercode = dr.Item("CSVName")
Case "webpage"
webpage = dr.Item("CSVName")
Case "mobile_phone"
mobile = dr.Item("CSVName")
End Select
Next
Dim sqlSelect As String = "SELECT Company, [" & add1 & "], [" & add3 & "], [" & postcode & "], [" & add2 & "], " & _
"[" & telephone & "], [" & fax & "], [" & email & "], [" & customercode & "], " & _
"[" & add4 & "], [" & add5 & "], [" & webpage & "], [" & mobile & "] FROM " & fi.Name
Dim cmdSelect As New OleDbCommand(sqlSelect, conn)
Dim adapter1 As New OleDbDataAdapter(cmdSelect)
Dim ds As New DataSet
adapter1.Fill(ds, "DATA")
pb_progress.Maximum = ds.Tables(0).Rows.Count
pb_progress.Value = 0
For Each dr As DataRow In ds.Tables(0).Rows
Try
Debug.WriteLine(dr.Item(customercode).ToString.Trim)
If dr.Item(customercode).ToString.Trim = "" Then
Dim str As String = dr.Item(customername)
If str.Trim = "" Then Continue For
Dim length As Integer = str.Length
If length < 20 Then
Else
length = 20
End If
str = Replace(str.Substring(0, length), " ", "_").ToUpper
str = Regex.Replace(str, "[^a-zA-Z _&]", "")
Dim found As Boolean = True
Dim loopcount As Integer = 1
Do Until found = False
Dim checkSql As String = "SELECT * FROM Customers WHERE [Customer_Code] = #ccode"
Dim checkCmd As New OleDb.OleDbCommand(checkSql, con)
checkCmd.Parameters.AddWithValue("#ccode", str)
Dim checkDa As New OleDb.OleDbDataAdapter(checkCmd)
Dim checkDt As New DataTable
checkDa.Fill(checkDt)
If checkDt.Rows.Count <> 0 Then
found = True
str &= CStr(loopcount)
loopcount += 1
Else
found = False
End If
Loop
dr.Item(customercode) = str
Else
Dim found As Boolean = True
Dim loopcount As Integer = 1
Do Until found = False
Dim checkSql As String = "SELECT * FROM Customers WHERE [Customer_Code] = #ccode"
Dim checkCmd As New OleDb.OleDbCommand(checkSql, con)
checkCmd.Parameters.AddWithValue("#ccode", dr.Item(customercode))
Dim checkDa As New OleDb.OleDbDataAdapter(checkCmd)
Dim checkDt As New DataTable
checkDa.Fill(checkDt)
If checkDt.Rows.Count <> 0 Then
found = True
dr.Item(customercode) &= CStr(loopcount)
loopcount += 1
Else
found = False
End If
Loop
End If
Dim sql As String
sql = "INSERT INTO Customers(Customer_Code, Customer_Name, Contract_Payment_Terms, Aq_Date, Telephone, Fax, Email, Average_Payment_Terms, webpage, mobile_phone) " & _
"VALUES(#ccode, #cname, 30, #01/01/2016#, #ctele, #cfax, #email, 30, #webpage, #mobile);"
Dim cmd As New OleDb.OleDbCommand(sql, con)
With cmd.Parameters
.AddWithValue("#ccode", dr.Item(customercode))
.AddWithValue("#cname", dr.Item(customername))
.AddWithValue("#ctele", dr.Item(telephone).ToString.Truncate(48))
.AddWithValue("#cfax", dr.Item(fax))
.AddWithValue("#email", dr.Item(email))
.AddWithValue("#webpage", dr.Item(webpage))
.AddWithValue("#mobile", dr.Item(mobile))
End With
cmd.ExecuteNonQuery()
sql = "INSERT INTO [Customer_Addresses] (Cust_Code, PostCode, Alias, Add1, Add2, Add3, Add4, Add5) VALUES(#ccode, #pcode, 'Default'" & _
",#add1, #add2, #add3, #add4, #add5);"
cmd = New OleDb.OleDbCommand(sql, con)
With cmd.Parameters
.AddWithValue("#ccode", dr.Item(customercode))
.AddWithValue("#pcdoe", dr.Item(postcode))
.AddWithValue("#add1", dr.Item(add1))
.AddWithValue("#add2", dr.Item(add2))
.AddWithValue("#add3", dr.Item(add3))
.AddWithValue("#add4", dr.Item(add4))
.AddWithValue("#add5", dr.Item(add5))
End With
cmd.ExecuteNonQuery()
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
pb_progress.Increment(1)
Next
MsgBox("Import successful", MsgBoxStyle.OkOnly, "Success")
Catch ex As Exception
errorLog(ex)
End Try
End Sub
Inputbox will always return a String.
If the Users presses "OK" it will return the String put into the TextBox.
If he cancels the box by pressing X or Cancel it returns "".
I would generally not recommend using an Inputbox for getting a filepath. Use an OpenFileDialog instead. If you have the fullpath already in your Clipboard you can just paste it into the Filename-Textboxof the OFD and press enter.
This should get you started:
Dim ofd as new OpenFileDialog()
// Show the File Dialog to the user and detect he pressed OK or Cancelled
if ofd.ShowDialog = Windows.Forms.DialogResult.OK
// Always check, if the file really exists
if IO.File.exists(ofd.FileName)
importbox = ofd.FileName
Else
msgbox("File does not exist")
Exit Sub
End if
Else
Exit Sub
End if
I have in my project 2 buttons to import from Excel and export to Excel and a datagridview. I can import Excel files with no problem but when I export from datagridview to Excel and try to re-import that file I only get just one column header with "F1" in it:
This is the code for export button:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
'Creamos las variables
Dim exApp As New Excel.Application
Dim exLibro As Excel.Workbook
Dim exHoja As Excel.Worksheet
Try
'Añadimos el Libro al programa, y la hoja al libro
exLibro = exApp.Workbooks.Add
exHoja = exLibro.Worksheets.Add()
' ¿Cuantas columnas y cuantas filas?
Dim NCol As Integer = DataGridView1.ColumnCount
Dim NRow As Integer = DataGridView1.RowCount
'Aqui recorremos todas las filas, y por cada fila todas las columnas
'y vamos escribiendo.
For i As Integer = 1 To NCol
exHoja.Cells.Item(1, i) = DataGridView1.Columns(i - 1).Name.ToString
Next
For Fila As Integer = 0 To NRow - 1
For Col As Integer = 0 To NCol - 1
exHoja.Cells.Item(Fila + 2, Col + 1) = DataGridView1.Item(Col, Fila).Value
Next
Next
'Titulo en negrita, Alineado al centro y que el tamaño de la columna
'se ajuste al texto
exHoja.Rows.Item(1).Font.Bold = 1
exHoja.Rows.Item(1).HorizontalAlignment = 3
exHoja.Columns.AutoFit()
'Aplicación visible
exApp.Application.Visible = True
exHoja = Nothing
exLibro = Nothing
exApp = Nothing
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
What can I do to solve it??
Thanks.
For an import from Excel where the top image depicts what happens using SELECT *
The bottom image shows using field aliasing as shown in the code below
Code to read sheet data using aliasing
Dim dt As New DataTable
Dim FileName As String = IO.Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "SampleData.xlsx")
Using cn As New OleDb.OleDbConnection With
{
.ConnectionString = ConnectionHelper.ConnectionString(FileName, "No")
}
Console.WriteLine(cn.ConnectionString)
' .CommandText = "SELECT F1 As FirstName, F2 As MiddleName, F3 As LastName FROM [PeopleData$] ORDER BY F3",
Using cmd As New OleDb.OleDbCommand With
{
.CommandText = "SELECT F1 As FirstName, F2 As MiddleName, F3 As LastName FROM [Sheet1$] ORDER BY F3",
.Connection = cn
}
cn.Open()
dt.Load(cmd.ExecuteReader)
End Using
End Using
DataGridView1.DataSource = dt
Code for above to set connection
Public Module ConnectionHelper
Public Function ConnectionString(ByVal FileName As String) As String
Dim Builder As New OleDb.OleDbConnectionStringBuilder
If IO.Path.GetExtension(FileName).ToUpper = ".XLS" Then
Builder.Provider = "Microsoft.Jet.OLEDB.4.0"
Builder.Add("Extended Properties", "Excel 8.0;IMEX=2;HDR=No;")
Else
Builder.Provider = "Microsoft.ACE.OLEDB.12.0"
Builder.Add("Extended Properties", "Excel 12.0;IMEX=2;HDR=No;")
End If
Builder.DataSource = FileName
Return Builder.ConnectionString
End Function
Public Function ConnectionString(ByVal FileName As String, ByVal Header As String) As String
Dim Builder As New OleDb.OleDbConnectionStringBuilder
If IO.Path.GetExtension(FileName).ToUpper = ".XLS" Then
Builder.Provider = "Microsoft.Jet.OLEDB.4.0"
Builder.Add("Extended Properties", String.Format("Excel 8.0;IMEX=1;HDR={0};", Header))
Else
Builder.Provider = "Microsoft.ACE.OLEDB.12.0"
Builder.Add("Extended Properties", String.Format("Excel 12.0;IMEX=1;HDR={0};", Header))
End If
Builder.DataSource = FileName
Return Builder.ConnectionString
End Function
End Module
Note the sheet has no column name, ony data. If the first row had column names the connection would have Yes as argument 2 rather than No as above .ConnectionString = ConnectionHelper.ConnectionString(FileName, "Yes")
I found the solution, the problem wasn´t the Import button, instead it seems to be the Export button because it export the file with some kind of damage. I tried with other code I found (to export) and worked, This is the working code:
Dim stRuta As String = ""
Dim openFD As New OpenFileDialog()
With openFD
.Title = "Seleccionar archivos"
.Filter = "Archivos Excel(*.xls;*.xlsx)|*.xls;*xlsx|Todos los archivos(*.*)|*.*"
.Multiselect = False
.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.Desktop
If .ShowDialog = Windows.Forms.DialogResult.OK Then
stRuta = .FileName
End If
End With
Try
'Dim stConexion As String = ("Provider=Microsoft.ACE.OLEDB.12.0;" & ("Data Source=" & (stRuta & ";Extended Properties=""Excel 12.0;Xml;HDR=YES;IMEX=2"";")))
Dim stConexion As String = ("Provider=Microsoft.ACE.OLEDB.12.0;" & ("Data Source=" & (stRuta & ";Extended Properties=""Excel 12.0;Xml;HDR=YES;IMEX=2"";")))
Dim cnConex As New OleDbConnection(stConexion)
Dim Cmd As New OleDbCommand("Select * From [Hoja1$]")
Dim Ds As New DataSet
Dim Da As New OleDbDataAdapter
Dim Dt As New DataTable
cnConex.Open()
Cmd.Connection = cnConex
Da.SelectCommand = Cmd
Da.Fill(Ds)
Dt = Ds.Tables(0)
Me.DataGridView1.Columns.Clear()
Me.DataGridView1.DataSource = Dt
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Error")
End Try
Thank you all :)
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.
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