problemas al importar y guardar un excel VB 6.3

[kamumaki]

buenos dias forofos!!!

tengo un problemilla que es el siguiente:

tengo dos botones en un form uno importa un excel a una tabla de acces y el otro abre un excel y puedo modificarlo y guardarlo.

si al iniciar el aplicativo abro un excel y lo modifico no me da ningun problema,
pero si al iniciar importo el arxivo excel a la tabla y luego abro el excel k acabo de importar, y lo modifico solo me deja guardar una copia.

Tengo un procedimiento que me libera los objetos k uso a la hora de importar:

'Descarga los objetos y los cierra
Sub Descargar_Objetos(rst As Recordset, bd As Database, Obj_Excel As Object, Obj_Hoja As Object)


Set rst = Nothing
bd.Close
Set bd = Nothing
Obj_Excel.ActiveWorkbook.Close False
Obj_Excel.Quit
Set Obj_Hoja = Nothing
Set Obj_Excel = Nothing
Set oexc = Nothing

End Sub

alguna sugerencia???
gracias!!!

[David]

Si te deja solo abrir una copia, tal vez lo estés abriendo en Modo Solo Lectura, ¿cuál es la instrucción que estás usando para Abrir el archivo?

[kamumaki]

buenas David!
ahi va el codigo y recuerdo que si lo único que hago es abrir los excels, me deja guardarlos.
El problema esta en k al importar un excel, luego me deja abrirlo pero no guardarlo.


'codigo abrir excel
Private Sub BtnObrirExcel_Click()
Dim objExcel
Dim objWorkbook
Dim finestra As CommonDialog
Dim ErrorRuta As Boolean
Set finestra = New CommonDialog


TempVars.RemoveAll
ErrorRuta = True
finestra.DialogTitle = "Sel·lecciona un arxiu excel"
finestra.Filter = "Archius excel 2000 - 2003|*.xls|Archius Excel 2007|*.xlsx"
finestra.ShowOpen
If finestra.FileName <> "" Then
Ruta = finestra.FileName
ErrorRuta = False
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkbook = objExcel.Workbooks.Open(Ruta)
objExcel.Visible = True
End If

End Sub





'------------------------Importar excels
Public Function Excel_a_Access(Path_BD As String, _
Path_XLS As String, _
La_Tabla As String, _
Filas As Integer, _
Columnas As Integer) As Boolean
' Variables para acceder al libro de excel
Dim Obj_Excel As Object
Dim Obj_Hoja As Object
' Variables para la base de datos y el recordset dao
Dim bd As Database
Dim rst As Recordset
' Variables para la fila, la columna y el dato a copiar
Dim Fila_Actual As Integer
Dim Columna_Actual As Integer
Dim x As Integer
Dim F As Integer
Dim C As Integer
Dim Dato As Variant
Dim Buit As Boolean
Dim sortir As Boolean

Dim oExcel As Excel.Application
Dim xLibro As Excel.Workbook
Dim xHoja As Excel.Worksheet

Set oExcel = CreateObject("Excel.Application")
Set xLibro = oExcel.Workbooks.Open(Path_XLS)
Set xHoja = xLibro.Sheets(1)
On Error GoTo ErrSub
sortir = False
Screen.MousePointer = vbHourglass

'Crea una Nueva instancia de Excel
Set Obj_Excel = CreateObject("Excel.Application")

' Abre el libro pasandole el path
Obj_Excel.Workbooks.Open FileName:=Path_XLS

' si es la versión de Excel 97, asigna la hoja activa ( ActiveSheet )
If Val(Obj_Excel.Application.Version) >= 8 Then
Set Obj_Hoja = Obj_Excel.ActiveSheet
Else
Set Obj_Hoja = Obj_Excel
End If

'Abre la base de datos
Set bd = OpenDatabase(Path_BD)

' Llena el recordset indicandole la tabla
Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)

' Recorre las filas y columnas de la hoja
If (Filas = 0 And Columnas = 0) Then
Dim finestra As CommonDialog
Set finestra = New CommonDialog
Dim dbs As Database
Set dbs = CurrentDb
Dim RsAux As Recordset
DoCmd.TransferSpreadsheet 0, , "T_ETIQUETES_AUX", Path_XLS
Set RsAux = CurrentDb.OpenRecordset("SELECT * FROM T_ETIQUETES_AUX")
Form_gestio_impresio_etiquetes.BtnNetejar.Requery
Do While Not RsAux.EOF
dbs.Execute " INSERT INTO T_ETIQUETES(CAMPO_1, CAMPO_2, CAMPO_3, CAMPO_4, CAMPO_5, CAMPO_6, CAMPO_7, CAMPO_8) VALUES ('" & RsAux!F1 & "', '" & RsAux!F2 & "', '" & RsAux!F3 & "', '" & RsAux!F4 & "', '" & RsAux!F5 & "', '" & RsAux!F6 & "', '" & RsAux!F7 & "', '" & RsAux!F8 & "')"
RsAux.MoveNext
Loop
RsAux.Close
Form_gestio_impresio_etiquetes.Refresh
dbs.Execute ("DROP TABLE T_ETIQUETES_AUX;")
Else
'If ((Filas = 0) Or (Columnas = 0)) Then

If (Filas = 0) Then
Filas = xHoja.Columns(1).Find("").Row
End If
If (Columnas = 0) Then
Columnas = xHoja.Rows(1).Find("").Column
End If
If (Columnas > 8) Then
Columnas = 8
End If

For F = Filas To 1 Step -1
' Agergar un nuevo registro
rst.AddNew

' REcorre las columnas del libro
For Columna_Actual = 0 To Columnas - 1

' Almacena le dato de la celda actual
Dato = Trim$(Obj_Hoja.Cells(F, Columna_Actual + 1))
'Agrega los datos al campo indicado

rst(Columna_Actual).Value = Dato

Next
'Actualiza los datos en la tabla
rst.Update
Next
End If
Excel_a_Access = True
'DEscarga los objetos
Screen.MousePointer = vbDefault
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)


Exit Function

ErrSub:
'Resume Next
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault

End Function

'Descarga los objetos y los cierra
Sub Descargar_Objetos(rst As Recordset, bd As Database, Obj_Excel As Object, Obj_Hoja As Object)


Set rst = Nothing
bd.Close
Set bd = Nothing
'Obj_Excel.ActiveWorkbook.Close False
'Obj_Excel.Quit
Obj_Hoja = Nothing
Obj_Excel = Nothing
Set Obj_Hoja = Nothing
Set Obj_Excel = Nothing

End Sub