Dim xlApp As New Excel.Application
Dim xlWorkBook As
Excel.Workbook
xlWorkBook
= xlApp.Workbooks.Open("C:\mifichero.xlsx",, CorruptLoad:=XlCorruptLoad.xlRepairFile)
xlWorkBook.SaveAs("C:\mifichero_reparado.xlsx")
xlWorkBook.Close()
PROPORCIONAR USUARIO ESPECÍFICO PARA LA EJECUCIÓN DEL CÓDIGO
'Ejecutar la aplicación de Visual Studio obtiene los
derechos de lectura y escritura de archivos, por lo que el código está en
ejecución, pero desde el navegador no está recibiendo los derechos adecuados
para por ejemplo guardar un archivo por lo que debe proporcionar / conceder los
derechos para hacerlo correctamente.
Private impersonateValitedUser As Boolean
= False
Dim LOGON32_LOGON_INTERACTIVE As Integer
= 2
Dim LOGON32_PROVIDER_DEFAULT As
Integer = 0
#Region "Impersonation"
Dim impersonationContext As WindowsImpersonationContext
Declare Function
LogonUserA Lib
"advapi32.dll"
(ByVal
lpszUsername As String,
ByVal lpszDomain As String,
ByVal lpszPassword As String,
ByVal dwLogonType As Integer,
ByVal dwLogonProvider As Integer,
ByRef phToken As IntPtr)
As Integer
Declare Auto
Function DuplicateToken Lib "advapi32.dll" (
ByVal ExistingTokenHandle As IntPtr,
ByVal ImpersonationLevel As Integer,
ByRef DuplicateTokenHandle As IntPtr) As Integer
Declare Auto
Function RevertToSelf Lib "advapi32.dll" () As Long
Declare Auto
Function CloseHandle Lib "kernel32.dll" (ByVal
handle As IntPtr) As Long
Private Function
impersonateValidUser(ByVal
userName As String,
ByVal domain As String, ByVal password As
String) As Boolean
Dim tempWindowsIdentity As WindowsIdentity
Dim token As IntPtr = IntPtr.Zero
Dim tokenDuplicate As IntPtr
= IntPtr.Zero
impersonateValidUser = False
If RevertToSelf() Then
If LogonUserA(userName, domain, password, LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, token) <> 0 Then
If DuplicateToken(token, 2, tokenDuplicate) <> 0 Then
tempWindowsIdentity = New WindowsIdentity(tokenDuplicate)
impersonationContext =
tempWindowsIdentity.Impersonate()
If Not
impersonationContext Is
Nothing Then
impersonateValidUser = True
impersonateValitedUser
= True
End If
End If
End If
End If
If Not
tokenDuplicate.Equals(IntPtr.Zero) Then
CloseHandle(tokenDuplicate)
End If
If Not
token.Equals(IntPtr.Zero)
Then
CloseHandle(token)
End If
End Function
Private Sub
undoImpersonation()
impersonationContext.Undo()
End Sub
#End Region
Public Sub
MySub()
If impersonateValidUser("Username", "Domain", "Password") Then
'aquí el código que se ejecuta bajo el
contexto de seguridad de un usuario específico --> …
'… <-- span="">
undoImpersonation()
Else
End If
End Sub
CREAR LISTA DE RESULTADOS DE UNA CONSULTA SOBRE DATASET CON LINQ ... FINALMENTE LOS CARGAMOS EN UN COMBOBOX
cbValores.DataSource
= Nothing
Dim results = (From
row In
DsValues.Tables("table1").Select("valor_filter > 1").AsEnumerable()Select VALOR1 = row.Field(Of String)(1),
VALOR2 = row.Field(Of
String)(2)).Distinct().ToList()
cbValores.DataSource
= results
cbValores.DisplayMember
= "VALOR1"
cbValores.ValueMember
= "VALOR2"
IMPORTAR / EXPORTAR DATOS EXCEL A DATASET / DATASET A EXCEL
Private Shared
Function Import(ByRef initialIndex As Integer)
As DataSet
'Dim
connectionString As String =
String.Format("provider=Microsoft.Jet.OLEDB.4.0; data source={0};Extended
Properties=Excel 8.0;;HDR=YES;", _ExcelFile_Source)
Dim connectionString As String
= String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data
Source={0};Extended Properties=Excel 12.0;",
_ExcelFile_Source)
For Each
sheetName In
GetExcelSheetNames(connectionString)
Using con As New OleDbConnection(connectionString)
Dim dataTable = New
DataTable()
Dim query As String = String.Format("SELECT * FROM [{0}]", sheetName)
con.Open()
Dim adapter As
New OleDbDataAdapter(query,
con)
adapter.Fill(dataTable)
dataTable.AcceptChanges()
_ExcelDataset.Tables.Add(dataTable)
End Using
Next
Return _ExcelDataset
End Function
Public Sub
Export()
Dim Excel As Object = CreateObject("Excel.Application")
Dim wBook As
Microsoft.Office.Interop.Excel.Workbook
Dim wSheet As
Microsoft.Office.Interop.Excel.Worksheet
wBook = Excel.Workbooks.Add()
wSheet = wBook.ActiveSheet()
Dim _sheetname As
String = ""
Try
Dim dt As System.Data.DataTable =
_ExcelDataset.Tables(0)
Dim dc As System.Data.DataColumn
Dim dr As System.Data.DataRow
Dim colIndex As
Integer = 0
Dim rowIndex As
Integer = 0
For Each
dc In dt.Columns
colIndex = colIndex + 1
Excel.Cells(1, colIndex) = dc.ColumnName
Next
For Each
dr In dt.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each
dc In dt.Columns
colIndex = colIndex + 1
Excel.Cells(rowIndex + 1,
colIndex) = dr(dc.ColumnName)
Next
Next
Catch ex As Exception
MsgBox("Error de
conversión.", MsgBoxStyle.Critical, "Error")
End
Try
Try
wSheet.Name = "Resultado"
_sheetname = wSheet.Name
Catch ex As Exception
MsgBox("Error de formato.", MsgBoxStyle.Critical, "Error")
End
Try
Try
'Check
if file exists if not, save file
Dim button As DialogResult
If System.IO.File.Exists(_ExcelFile_Result)
Then
button = MessageBox.Show _
("Ya existe el
archivo " & _ExcelFile_Result & ", ¿Quieres reemplazarlo?",
"¡Ojo!", MessageBoxButtons.YesNo,
MessageBoxIcon.Warning,
MessageBoxDefaultButton.Button1)
If button = System.Windows.Forms.DialogResult.Yes Then
Excel.DisplayAlerts = False
wBook.SaveAs(_ExcelFile_Result,
True)
MsgBox("El archivo se
ha guardado correctamente.")
Else
Dim i As String
_sheetname = ""
_sheetname = "Result.xls"
Dim _path As String = System.IO.Path.GetFullPath(_ExcelFile_Result)
i = InputBox("Informa el
nombre de archivo", "", _sheetname, 200, 200)
_ExcelFile_Result
= _path & "\"
& i
wBook.SaveAs(_ExcelFile_Result, True)
MsgBox("El archivo se
ha guardado correctamente en " & _path)
End If
End If
Catch ex As Exception
MsgBox("Error a guardar el archivo. Revise la
direccion", MsgBoxStyle.Exclamation, "Error")
wSheet
= Nothing
wBook = Nothing
Excel.Quit()
Excel = Nothing
GC.Collect()
End Try
Excel.Visible = True
GC.Collect()
End Sub
Private Shared
Function
GetExcelSheetNames(connectionString As String)
As String()
Dim con As OleDbConnection
= Nothing
Dim dt As DataTable = Nothing
con = New OleDbConnection(connectionString)
con.Open()
dt = con.GetOleDbSchemaTable(OleDbSchemaGuid.Tables,
Nothing)
If dt Is Nothing Then
Return Nothing
End If
Dim excelSheetNames As [String]()
= New
[String](dt.Rows.Count - 1)
{}
Dim i As Integer = 0
For Each
row As DataRow In dt.Rows
excelSheetNames(i) = row("TABLE_NAME").ToString()
i += 1
Next
Return excelSheetNames
End Function
Suscribirse a:
Entradas (Atom)