Hello:

I have a question relating to the joining of two tables. I have spent a lot
of time checking different threads but cannot find an answer to my need. I am
a newbie so I may have seen the answer and didn't realize it.

I am using Excel 2003. I have two workbooks that I would like to join
horizontally.

I have attached code that works however, in my .xls file there is both text
and values and the data
does not get copied. I am not sure what is the solution.

Sub merge_tables()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
' create variables
Dim fs As Object
Dim a As Object
Dim retstring As String
Dim retstring2 As String
Dim mypath As String
Dim toklen As Integer
Dim toklen2 As Integer
Dim myFSO As Object
Dim myFSO2 As Object

mypath = "d:\procdata\d740\"

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(mypath & "elems.txt", ForReading, TristateFalse)
Do While a.AtEndOfLine < True

retstring = LCase(a.Readline)

toklen = Len(retstring)
toklen2 = toklen - 2

retstring2 = Mid(retstring, 2, toklen2)
'MsgBox retstring2

ChDir mypath & "statistics"

Set myFSO = CreateObject("Scripting.FileSystemObject")
If myFSO.FileExists(mypath & "statistics\" & "predicted_conditions_"
& retstring2 & ".xls") Then

Set myFSO2 = CreateObject("Scripting.FileSystemObject")
If myFSO2.FileExists(mypath & "statistics\" &
"current_conditions_" & retstring2 & ".xls") Then

Call mergeit(retstring2, mypath)

Else
MsgBox "File Does Not Exist"
End If
Set myFSO2 = Nothing

Else
MsgBox "File Does Not Exist"
End If
Set myFSO = Nothing

Loop
a.Close

Set a = Nothing
Set fs = Nothing

End Sub


Sub mergeit(retstring2 As String, mypath As String)

Dim srcstr As String
Dim deststr As String
Dim ls_file As String

srcstr = mypath & "statistics\" & "predicted_conditions_" & retstring2 &
".xls"
deststr = mypath & "statistics\" & "forest_composition_" & retstring2 & ".
xls"
ls_file = mypath & "statistics\" & "current_conditions_" & retstring2 & ".
xls"

If Dir(deststr) < "" Then
Kill deststr
End If

FileCopy srcstr, deststr

Workbooks.Open Filename:= _
mypath & "statistics\" & "forest_composition_" & retstring2 & ".xls"

' uncomment these lines after fixing the proc
'Worksheets("predicted_conditions_" & retstring2).Activate
Range("I1").Select

GetDataFromClosedWorkbook ls_file, "A1:k29", ActiveSheet.Range("I1:s29"),
False

' Call forest_composition
'
' Selection.Delete Shift:=xlToLeft
'Range("F20").Select
'
'Workbooks("predicted_conditions_" & retstring2 & ".xls").Close
savechanges:=False
'Workbooks("current_conditions_" & retstring2 & ".xls").Close savechanges:
=False
Workbooks("forest_composition_" & retstring2 & ".xls").Close savechanges:
=True

'ActiveWorkbook.SaveAs Filename:=(mypath & "statistics\" &
"forest_composition_" & retstring2 & ".xls"), FileFormat:=xlExcel9795,
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:
=False
'
' Workbooks("forest_composition_" & retstring2 & ".xls").Close SaveChanges:
=Fals

End Sub

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
TargetRange As Range, IncludeFieldNames As Boolean)
''src:http://www.excelforum.com/archive/in.../t-325834.html

' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
' this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
' this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"ReadOnly=1;DBQ=" & SourceFile
Set dbConnection = New ADODB.Connection
On Error GoTo InvalidInput
dbConnection.Open dbConnectionString ' open the database connection
Set rs = dbConnection.Execute("[" & SourceRange & "]")
Set TargetCell = TargetRange.Cells(1, 1)
If IncludeFieldNames Then
For i = 0 To rs.Fields.Count - 1
TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
Next i
Set TargetCell = TargetCell.Offset(1, 0)
End If
TargetCell.CopyFromRecordset rs
rs.Close
dbConnection.Close ' close the database connection
Set TargetCell = Nothing
Set rs = Nothing
Set dbConnection = Nothing
On Error GoTo 0
Exit Sub
InvalidInput:
MsgBox "The source file or source range is invalid!", _
vbExclamation, "Get data from closed workbook"
End Sub

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200711/1