Hice este programita, pero ahora que creé uno nuevo con el mismo código pero con diferente diseño, ya no me corre
Imports System.Data
Imports Microsoft.Office.Interop
Public Class Form2
Private Sub CargarFormato28BToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles CargarFormato28BToolStripMenuItem.Click
Dim openFileDialog1 = New OpenFileDialog()
openFileDialog1.InitialDirectory = "C:\planeacion\"
openFileDialog1.Filter = "Excel Worksheets|*.xls; *.xlsx"
openFileDialog1.FilterIndex = 2
openFileDialog1.RestoreDirectory = True
If openFileDialog1.ShowDialog() = Microsoft.Office.Interop.Excel.Windows.Forms.DialogResult.OK Then
Try
'MessageBox.Show(openFileDialog1.FileName)
CargaArchivoOriginal(openFileDialog1.FileName)
Catch ex As System.Exception
MessageBox.Show("Error")
End Try
End If
End Sub
'Private Sub CargaArchivoOriginal(ByVal nombreArchivo As String)
' Dim xlApp As Microsoft.Office.Interop.Excel.Application
' Dim xlWorkbook As Microsoft.Office.Interop.Excel.Workbook
' Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
' Dim xlRange As Microsoft.Office.Interop.Excel.Range
' Try
' Dim xlCol As Integer
' Dim xlRow As Integer
' Dim Data(0 To 16) As String
' Dim dt As New DataTable("Test")
' With dt
' .Clear()
' xlApp = New Microsoft.Office.Interop.Excel.Application
' xlWorkbook = xlApp.Workbooks.Open(nombreArchivo)
' For Each ws As Excel.Worksheet In xlWorkbook.Sheets
' If ws.Name = "28b Original" Then
' xlWorkSheet = ws
' Exit For
' End If
' Next
' xlRange = xlWorkSheet.UsedRange
' If xlRange.Columns.Count > 0 Then
' If xlRange.Rows.Count > 0 Then
' For xlRow = 2 To xlRange.Rows.Count 'here the xlRow is start from 2 coz in exvel sheet mostly 1st row is the header row
' For xlCol = 1 To xlRange.Columns.Count
' Data(xlCol - 1) = xlRange.Cells(xlRow, xlCol).text
' Next
' .LoadDataRow(Data, True)
' Next
' xlWorkbook.Close()
' xlWorkbook = Nothing
' xlApp.Quit()
' xlApp = Nothing
' releaseObject(xlWorkbook)
' releaseObject(xlApp)
' End If
' End If
' xlWorkbook.Close(False)
' xlApp.Quit()
' releaseObject(xlWorkbook)
' releaseObject(xlApp)
' End With
' Catch
' If Not IsNothing(xlWorkbook) Then
' xlWorkbook.Close()
' releaseObject(xlWorkbook)
' End If
' If Not IsNothing(xlApp) Then
' xlApp.Quit()
' releaseObject(xlApp)
' End If
' End Try
'End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
Private Sub CargaArchivoOriginal(ByVal nombreArchivo As String)
Try
Dim MyConnection As OleDb.OleDbConnection
Dim DtSet As DataSet
Dim dt As DataTable
Dim MyCommand As OleDb.OleDbDataAdapter
Dim semana = InputBox("Que semana es?", "Seleccione semana")
If semana = "" Then
MsgBox("Es necesaria la semana")
Else
MyConnection = New OleDb.OleDbConnection(String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1;""", nombreArchivo))
' MyConnection = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & nombreArchivo & "';Extended Properties=""Excel 12.0;HDR=YES;""")
'MyConnection = New OleDb.OleDbConnection("provider=Microsoft.Jet.OLEDB.4.0; Data Source='" & nombreArchivo & "'; Extended Properties=""Excel 8.0;IMEX=1;HDR=YES;TypeGuessRows=0;ImportMixedTypes=Text""")
MyCommand = New OleDb.OleDbDataAdapter("select * from [28b Original$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New DataSet
dt = New DataTable
MyCommand.AcceptChangesDuringFill = False
MyCommand.AcceptChangesDuringUpdate = False
MyCommand.Fill(dt)
'MessageBox.Show(dt.Rows.Count)
Dim column = New DataColumn("SEMANA")
column.DefaultValue = semana
dt.Columns.Add(column)
column.SetOrdinal(0)
Dim column2 = New DataColumn("DATERECORD")
column2.DefaultValue = Date.Now
dt.Columns.Add(column2)
DataGridView1.DataSource = dt
MyConnection.Close()
InsertarAAccess(dt)
Actualizar()
AbreArchivoConcatenado("C:\planeacion\28b concatenados.xlsm")
End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub InsertarAAccess(ByRef dt As DataTable)
Dim MyConnection As OleDb.OleDbConnection
Dim Ocmd As OleDb.OleDbCommandBuilder
Dim BDPath As String
Dim oleAdapter As OleDb.OleDbDataAdapter
Dim sql As String = "SELECT top 1 [WEEK NUM], PARTNUMBER,REQUESTDATE, FORECASTQUANTITY, FORECASTAMOUNT, FORECASTTYPE, SHIPTONUMBER, BILLTONUMBER, CUSTOMERDESCRIPTION, BRANCH, SHORTITEMNO, CUSTVEND, PARENTNAME, SHIPTOSITE, PRICE, STDCOST, STDCUTLP, STDFA FROM [28b Original]"
Dim insert = "INSERT INTO [28b Original] ([WEEK NUM], PARTNUMBER,REQUESTDATE, FORECASTQUANTITY, FORECASTAMOUNT, FORECASTTYPE, SHIPTONUMBER, BILLTONUMBER, CUSTOMERDESCRIPTION, BRANCH, SHORTITEMNO, CUSTVEND, PARENTNAME, SHIPTOSITE, PRICE, STDCOST, STDCUTLP, STDFA, [DATE RECORD])" & _
"VALUES (@SEMANA, @PARTNUMBER,@REQUESTDATE, @FORECASTQUANTITY, @FORECASTAMOUNT, @FORECASTTYPE, @SHIPTONUMBER, @BILLTONUMBER, @CUSTOMERDESCRIPTION, @BRANCH, @SHORTITEMNO, @CUSTVEND, @PARENTNAME, @SHIPTOSITE, @PRICE, @STDCOST, @STDCUTLP, @STDFA, @DATERECORD)"
BDPath = "C:\planeacion\28b REV 1.0.accdb"
Try
MyConnection = New OleDb.OleDbConnection(String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0}", BDPath))
oleAdapter = New OleDb.OleDbDataAdapter(sql, MyConnection)
oleAdapter.InsertCommand = New OleDb.OleDbCommand(insert)
oleAdapter.InsertCommand.Parameters.Add("@SEMANA", OleDb.OleDbType.VarChar, 255, "SEMANA")
oleAdapter.InsertCommand.Parameters.Add("@PARTNUMBER", OleDb.OleDbType.VarChar, 255, "PARTNUMBER")
oleAdapter.InsertCommand.Parameters.Add("@REQUESTDATE", OleDb.OleDbType.DBDate, 50, "REQUESTDATE")
oleAdapter.InsertCommand.Parameters.Add("@FORECASTQUANTITY", OleDb.OleDbType.Double, 50, "FORECASTQUANTITY")
oleAdapter.InsertCommand.Parameters.Add("@FORECASTAMOUNT", OleDb.OleDbType.VarChar, 255, "FORECASTAMOUNT")
oleAdapter.InsertCommand.Parameters.Add("@FORECASTTYPE", OleDb.OleDbType.VarChar, 255, "FORECASTTYPE")
oleAdapter.InsertCommand.Parameters.Add("@SHIPTONUMBER", OleDb.OleDbType.VarChar, 255, "SHIPTONUMBER")
oleAdapter.InsertCommand.Parameters.Add("@BILLTONUMBER", OleDb.OleDbType.VarChar, 255, "BILLTONUMBER")
oleAdapter.InsertCommand.Parameters.Add("@CUSTOMERDESCRIPTION", OleDb.OleDbType.VarChar, 255, "CUSTOMERDESCRIPTION")
oleAdapter.InsertCommand.Parameters.Add("@BRANCH", OleDb.OleDbType.VarChar, 255, "BRANCH")
oleAdapter.InsertCommand.Parameters.Add("@SHORTITEMNO", OleDb.OleDbType.VarChar, 255, "SHORTITEMNO")
oleAdapter.InsertCommand.Parameters.Add("@CUSTVEND", OleDb.OleDbType.VarChar, 255, "CUSTVEND")
oleAdapter.InsertCommand.Parameters.Add("@PARENTNAME", OleDb.OleDbType.VarChar, 255, "PARENTNAME")
oleAdapter.InsertCommand.Parameters.Add("@SHIPTOSITE", OleDb.OleDbType.VarChar, 255, "SHIPTOSITE")
oleAdapter.InsertCommand.Parameters.Add("@PRICE", OleDb.OleDbType.Double, 50, "PRICE")
oleAdapter.InsertCommand.Parameters.Add("@STDCOST", OleDb.OleDbType.Double, 50, "STDCOST")
oleAdapter.InsertCommand.Parameters.Add("@STDCUTLP", OleDb.OleDbType.Double, 50, "STDCUTLP")
oleAdapter.InsertCommand.Parameters.Add("@STDFA", OleDb.OleDbType.Double, 50, "STDFA")
oleAdapter.InsertCommand.Parameters.Add("@DATERECORD", OleDb.OleDbType.DBDate, 50, "DATERECORD")
oleAdapter.InsertCommand.Connection = MyConnection
oleAdapter.InsertCommand.Connection.Open()
oleAdapter.AcceptChangesDuringUpdate = False
oleAdapter.AcceptChangesDuringFill = False
oleAdapter.Update(dt)
oleAdapter.InsertCommand.Connection.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Sub AbreArchivoConcatenado(ByVal FileName As String)
Dim xlsApp As Excel.Application
Dim xlsWB As Excel.Workbook
Dim xlsSheet As Excel.Worksheet
Dim xlsCell As Excel.Range
Dim xlsDatei As String
xlsApp = New Excel.Application
xlsApp.Visible = True
xlsWB = xlsApp.Workbooks.Open(FileName)
xlsSheet = xlsWB.Worksheets(1)
xlsSheet.Activate()
'xlsCell = xlsSheet.Range("A1")
End Sub
Private Sub btnActualizar_Click(sender As System.Object, e As System.EventArgs) Handles btnActualizar.Click
Actualizar()
End Sub
Private Sub Actualizar()
Dim oAccess As Object
Dim week As String
Dim macros As String = ""
'week = InputBox("Week")
oAccess = CreateObject("Access.Application")
' Open the database
oAccess.OpenCurrentDatabase("C:\planeacion\28b REV 1.0.accdb")
oAccess.Visible = False
Try
'For i = 0 To oAccess.CurrentProject.AllMacros.Count - 1
' macros += oAccess.CurrentProject.AllMacros(i).Name & ", "
'Next
'MessageBox.Show(macros)
oAccess.DoCmd.RunMAcro("RUTINAS")
Catch ex As Exception
MsgBox(ex.Message)
Finally
oAccess.CloseCurrentDatabase()
oAccess.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
End Try
End Sub
End Class
O si no ....... mejor esto ..... como puedo hacer que el form 2 sea la primera pantalla y no el form 1.
Gracias por su ayuda
Tema: Cambiar el formulario de inicio o arranque con Visual Basic (Leído 15043 veces)
RSS -
WAP2