access to excel automation...seem to still have a hidden excel instance.... (1 Viewer)

M

mytfein

Guest
Hi Everyone,

Background:
Another department intends to ftp a .txt file from the mainframe, for me to process.
The objective is to write a vb script that would be scheduled to run daily to process this .txt file.

Goal:
I am working on a vba script to:
a)open a text file in excel, map the text to columns, save as .xls spreadsheet
b) import excel spreadsheet to an access table

Accomplished most of (a) also using the macro recorder in EXCEL

Problem:
While the script works, my problem is:

I seem to have more than 1 excel instance running. Assuming this is so because:
a) when I go to explorer to open the .xls file that I just created, the computer hangs....
If I exit out of access, I can then view the .xls file
b) when execute the script for the first time, I get the following error code, which is what I want, because EXCEL should not be already running:

429
ActiveX component can't create object

If I run the script again, I get a 0, return code, which means that excel is running.
I want to always get a 429. Getting a 0, means a previous instance of excel exists....

'===================================================
Function WasExcelRunningBeforeThisExecution() As Boolean

On Error Resume Next

Set objExcel = GetObject(, "Excel.Application")

WasExcelRunningBeforeThisExecution = (Err.Number = 0) ' if err.number = 0, true else false

Debug.Print Err.Number
Debug.Print Err.Description


Err.Clear

End Function


c) if I go to ctl/alt/delete/task manager, I DO NOT see any EXCEL instances running
d) checked Access HELP, for method .opentext, in EXCEL,
HELP seems to explain that the method, opens the workbook and worksheet implicitly, so I commented out my explicit EXCEL field references.

Still having trouble. Your ideas are welcome.....

The script follows below. Thank you in advance for your time....
mytfein

'=========================================
Option Compare Database

Option Explicit

Dim objExcel As Excel.Application
' Dim objExcelActiveWkb As Excel.Workbook
' Dim objExcelActiveWs As Excel.Worksheet
Dim blnExcelAlreadyRunning As Boolean


Public Sub EagleUpload()

LaunchExcel

ImportTextToExcel2

SaveExcelSpreadsheet

CloseExcel (True)

ImportSpreadsheetToAccess

End Sub

'=======================================
Private Sub LaunchExcel()
On Error Resume Next

If WasExcelRunningBeforeThisExecution Then
blnExcelAlreadyRunning = True
Set objExcel = GetObject(, "Excel.Application")
Else
blnExcelAlreadyRunning = False
Set objExcel = CreateObject("Excel.Application")
End If

objExcel.Visible = True 'False


'objExcel.Application.Workbooks.Add
'Set objExcelActiveWkb = objExcel.Application.ActiveWorkbook

'Set objExcelActiveWs = objExcel.ActiveSheet

End Sub

'==========================================
Function WasExcelRunningBeforeThisExecution() As Boolean

On Error Resume Next

Set objExcel = GetObject(, "Excel.Application")

WasExcelRunningBeforeThisExecution = (Err.Number = 0) ' if err.number = 0, true else false
Debug.Print Err.Number
Debug.Print Err.Description


Err.Clear

End Function


'====================================
Private Sub SaveExcelSpreadsheet()

On Error GoTo SaveExcelSpreadsheet_Err


Const cstrPath As String = "c:\EagleEhsVisits.xls"

Kill cstrPath

'Set objExcelActiveWkb = objExcel.Application.ActiveWorkbook
'objExcelActiveWkb.SaveAs cstrPath

ActiveWorkbook.SaveAs Filename:=cstrPath, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

SaveExcelSpreadsheet_Exit:
Exit Sub

SaveExcelSpreadsheet_Err:
Select Case Err.Number

Case 53 ' kill didn't find the file - ignore error
'MsgBox Err.Number & " " & Err.Description
Resume Next

Case Else
MsgBox "Error # " & Err.Number & ": " & Err.Description
Resume SaveExcelSpreadsheet_Exit

End Select


End Sub

'==================================
Private Sub CloseExcel(blnHowToCloseExcel As Boolean)

On Error GoTo CloseExcel_Err


' objExcelActiveWkb.Close savechanges:=False

ActiveWorkbook.Close savechanges:=False
If Not blnExcelAlreadyRunning Then
objExcel.Application.Quit
End If




CloseExcel_Exit:
' Set objExcelActiveWs = Nothing
' Set objExcelActiveWkb = Nothing

Set objExcel = Nothing



Exit Sub

CloseExcel_Err:
MsgBox "Error # " & Err.Number & ": " & Err.Description
Resume CloseExcel_Exit


End Sub



'==========================



'====
Sub ImportTextToExcel2()

'
ChDir "C:\"
Workbooks.OpenText Filename:="C:\EHSPMMt.TXT", Origin:=xlWindows, StartRow _
:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(36, 2), Array _
(45, 2), Array(52, 1), Array(60, 2), Array(86, 2), Array(121, 2), Array(146, 2), Array(150, _
2), Array(152, 2), Array(161, 2), Array(163, 2), Array(174, 2), Array(186, 2), Array(197, 2 _
), Array(207, 2), Array(208, 2), Array(209, 2), Array(210, 2), Array(212, 2), Array(214, 2) _
, Array(221, 2), Array(222, 2), Array(230, 2), Array(240, 2), Array(247, 2), Array(248, 2), _
Array(250, 2), Array(261, 2), Array(270, 2), Array(280, 2), Array(290, 2), Array(297, 2), _
Array(298, 2), Array(300, 2), Array(310, 2), Array(320, 2), Array(328, 2), Array(329, 2), _
Array(330, 2), Array(334, 2), Array(340, 2), Array(341, 2), Array(410, 2), Array(480, 2), _
Array(481, 2), Array(499, 2), Array(519, 2), Array(520, 2), Array(521, 2), Array(522, 2), _
Array(530, 2))



Range("A1").Select
Selection.EntireRow.Insert
Range("A1").Select
ActiveCell.FormulaR1C1 = "header"
Range("B1").Select
ActiveCell.FormulaR1C1 = "filler1"
Range("C1").Select
ActiveCell.FormulaR1C1 = "patientNumber"
Range("D1").Select
ActiveCell.FormulaR1C1 = "filler2"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PatientName"
Range("F1").Select
ActiveCell.FormulaR1C1 = "PatientStreet"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PatientCity"
Range("H1").Select
ActiveCell.FormulaR1C1 = "PatientCounty"
Range("I1").Select
ActiveCell.FormulaR1C1 = "PatientState"
Range("J1").Select
ActiveCell.FormulaR1C1 = "PatientZip"
Range("K1").Select
ActiveCell.FormulaR1C1 = "PatienCountry"
Range("L1").Select
ActiveCell.FormulaR1C1 = "filler3"
Range("M1").Select
ActiveCell.FormulaR1C1 = "PatientPhone"
Range("N1").Select
ActiveCell.FormulaR1C1 = "PatientSSn"
Range("O1").Select
ActiveCell.FormulaR1C1 = "PatientDOB"
Range("P1").Select
ActiveCell.FormulaR1C1 = "G1"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "M1"
Range("R1").Select
ActiveCell.FormulaR1C1 = "filler4"
Range("S1").Select
ActiveCell.FormulaR1C1 = "R1"
Range("T1").Select
ActiveCell.FormulaR1C1 = "Rel"
Range("U1").Select
ActiveCell.FormulaR1C1 = "Chart#"
Range("V1").Select
ActiveCell.FormulaR1C1 = "E1"
Range("W1").Select
ActiveCell.FormulaR1C1 = "Medicare#"
Range("X1").Select
ActiveCell.FormulaR1C1 = "Medicaid#"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "filler5"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "E2"
Range("AA1").Select
ActiveCell.FormulaR1C1 = "filler6"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "filler7"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "filler8"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "filler9"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "filler10"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "filler11"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "T1"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "filler12"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "filler13"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "filler14"
Range("AK1").Select
ActiveCell.FormulaR1C1 = "filler15"
Range("AL1").Select
ActiveCell.FormulaR1C1 = "I1"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "filler16"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "filler17"
Range("AO1").Select
ActiveCell.FormulaR1C1 = "filler18"
Range("AP1").Select
ActiveCell.FormulaR1C1 = "U1"
Range("AQ1").Select
ActiveCell.FormulaR1C1 = "filler19"
Range("AR1").Select
ActiveCell.FormulaR1C1 = "filler20"
Range("AS1").Select
ActiveCell.FormulaR1C1 = "U2"
Range("AT1").Select
ActiveCell.FormulaR1C1 = "filler21"
Range("AU1").Select
ActiveCell.FormulaR1C1 = "E3"
Range("AV1").Select
ActiveCell.FormulaR1C1 = "I2"
Range("AW1").Select
ActiveCell.FormulaR1C1 = "R2"
Range("AX1").Select
ActiveCell.FormulaR1C1 = "A2"
Range("AY1").Select
ActiveCell.FormulaR1C1 = "UDATE"


Cells.Select
Selection.Columns.AutoFit



End Sub


Public Sub ImportSpreadsheetToAccess()


Dim strExcelFile As String
Dim strTableName As String

Dim strSql As String

strExcelFile = "c:\EagleEhsVisits.xls"
strTableName = "T_EagleEhsVisits2"

strSql = "DELETE FROM " & strTableName
CurrentDb.Execute (strSql)

DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=8, _
TableName:=strTableName, _
Filename:=strExcelFile, _
HasFieldNames:=True

End Sub
 
Last edited:

skwilliams

Registered User.
Local time
Today, 00:21
Joined
Jan 18, 2002
Messages
516
I currently use data from an AS/400 server daily in an MS Access database.

The information is saved as a delimited text file in a central location on our file server by the AS/400 operator.

I'm linking to the text file through MS Access using the File|Import Option. You shouldn't need to use Excel at all unless I'm missing something.

You can set your Windows Task Scheduler to open the Access DB at a specific time each day, then have the database run any needed code automatically at startup.

Hope this helps!!

:D
 

fpendino

Registered User.
Local time
Yesterday, 23:21
Joined
Jun 6, 2001
Messages
73
You shouldn't need Excel in this process at all. You can import the Text file directly into Access and should be able to automate the process with a Macro or VBA.

Try importing the text file into Access, save the 'Import Specifications'. If unfamiliar see this link (http://www.access-programmers.co.uk/forums/showthread.php?t=65394&highlight=import+spec) or check the help files.

When setting up the Macro or in VBA, use the TransferText Action and then you will specify this Import Specification and it will import your text file with the same settings that you have saved.
 

Users who are viewing this thread

Top Bottom