Pulling in Data from .123 Files in Excel
Harlan Grove
between .123 files and Excel using Excel VBA to automate 123. Requires both
Excel and 123 on the same machine. I thought I'd share it. It's beginning to
save me considerable time & effort.
'------ begin VBA ------
'This module contains macros to automate importing data from .123 files into
'Excel on machines with both Excel 97 or higher and 123R97 or higher
installed.
'
'Copyright (c) 2002 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'(at your option) any later version.
Option Explicit
'This is the user interface macro. Very crude. Prompted user entry of 123
'filename, 123 range, and Excel destination range (upper-top-left corner)
'using InputBox and Application.InputBox, then calls to the get123proc
'procedure that does the real work.
'To do: put all entries into a single user form.
Sub Get123()
Static lfn As String, lra As String, xda As String
Dim xdr As Range
lfn = InputBox("Enter 123 filename", "Get123", (lfn))
If lfn = "" Then Exit Sub
lra = InputBox("Enter 123 range address", "Get123", (lra))
If lra = "" Then Exit Sub
On Error Resume Next
Err.Clear
Set xdr = Application.InputBox("Enter destination range in Excel",
"Get123", xda, , , , , 8)
Err.Clear
On Error GoTo 0
If xdr Is Nothing Then Exit Sub Else xda = xdr.Address(False, False,
xlA1, True)
get123proc lfn, lra, xdr
End Sub
'This procedure does the real work. It creates an automation link to 123,
opens
'the specified 123 file (given by its lfn argument), pulls displayed values
from
'the specified range (given by its lra argument) in this file, and enters
those
'values in corresponding cells in Excel starting from the upper-top-left
cell
'(given by its xdr argument) of a 3D 'range'.
Private Sub get123proc(lfn As String, lra As String, xdr As Range)
Dim i As Long, j As Long, k As Long, n(1 To 3) As Long
Dim l123doc As Object, l123app As Object, l123rng As Object
Dim xwsc As Sheets, xwsi As Long, xda As String
Set l123doc = CreateObject("Lotus123.Workbook.97")
Set l123app = l123doc.Application
l123app.AutoExecMacrosEnabled = False
'l123app.Visible = True
On Error Resume Next
Set l123doc = l123app.OpenDocument(lfn)
If Err.Number <> 0 Then
MsgBox "Unable to read file" & Chr(13) & lfn & Chr(13) & "Macro
halted."
Err.Clear
Exit Sub
End If
Set l123rng = l123doc.Ranges(lra)
If Err.Number <> 0 Then
MsgBox "Unable to access range" & Chr(13) & lfn & Chr(13) & "Macro
halted."
Err.Clear
Exit Sub
End If
n(1) = l123rng.EndRow - l123rng.StartRow
n(2) = l123rng.EndColumn - l123rng.StartColumn
n(3) = l123rng.EndSheet - l123rng.StartSheet
Set xdr = xdr.Areas(1).Cells(1, 1)
Set xwsc = xdr.Parent.Parent.Worksheets
xwsi = xdr.Parent.Index
xda = xdr.Address(False, False, xlA1, False)
If xdr.Row + n(1) > 65536 Or xdr.Column + n(2) > 256 _
Or xwsi + n(3) > xwsc.Count Then
MsgBox "Block beginning at " & xdr.Address(False, False, xlA1, True)
& _
"isn 't large enough to contain <<" & lfn & ">>" & _
Application.Substitute(l123rng.CoordinateString, "$", "") & _
Chr(13) & "Macro halted."
Exit Sub
End If
For i = 0 To n(1)
For j = 0 To n(2)
For k = 0 To n(3)
xwsc(xwsi + k).Range(xda).Offset(i, j).Value = _
l123rng.Cell(i, j, k).CellDisplay
Next k
Next j
Next i
ErrorHandler:
On Error Resume Next
If l123app.Documents.Count = 1 Then l123app.Quit False
Set l123doc = Nothing
Set l123app = Nothing
Err.Clear
End Sub
'------ end VBA ------