gnod
03-14-2007, 09:34 AM
Hi,
This is the part of the project i can't figure out...
the CloseWorkbook is an old file that the user wants to copy to OpenWorkbook.. the format of the file is the same (validation, formula, etc)..
i just want to copy the values (highlighted in green) from CloseWorkbook to OpenWorkbook.. but the sheet in ClosedWorkbook is password protected then i create a Insert Row button so that user can insert a row even if the sheet is protected..
the problem is how do i know how many rows should i copy to OpenWorkbook if the Sheet1 of CloseWorkbook contains two table..
this is the code i use in OpenWorkbook to copy.. (http://www.rondebruin.nl/ado.htm#choose)
Sub CopyData()
Dim varData As Variant
Dim strFName As String
strFName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls", Title:="Open Actual Data")
If strFName <> "False" Then
GetData strFName, "Sheet1", "A3:B4", Sheets("Sheet1").Range("A3:B4"), False, False
Else
End
End If
End Sub
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"
On Error GoTo SomethingWrong
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
:help
Thanks..
This is the part of the project i can't figure out...
the CloseWorkbook is an old file that the user wants to copy to OpenWorkbook.. the format of the file is the same (validation, formula, etc)..
i just want to copy the values (highlighted in green) from CloseWorkbook to OpenWorkbook.. but the sheet in ClosedWorkbook is password protected then i create a Insert Row button so that user can insert a row even if the sheet is protected..
the problem is how do i know how many rows should i copy to OpenWorkbook if the Sheet1 of CloseWorkbook contains two table..
this is the code i use in OpenWorkbook to copy.. (http://www.rondebruin.nl/ado.htm#choose)
Sub CopyData()
Dim varData As Variant
Dim strFName As String
strFName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls", Title:="Open Actual Data")
If strFName <> "False" Then
GetData strFName, "Sheet1", "A3:B4", Sheets("Sheet1").Range("A3:B4"), False, False
Else
End
End If
End Sub
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"
On Error GoTo SomethingWrong
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
:help
Thanks..