Results 1 to 2 of 2
  1. #1
    Join Date
    Apr 2004
    Posts
    5

    Unanswered: access to excel automation...seem to still have a hidden excel instance....

    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) 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

  2. #2
    Join Date
    Sep 2004
    Posts
    161
    Maybe...
    I have make a test with your code, when i compile I have an error
    on the Workbooks.opentext "not enough of memory". decreases the number of array and try

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •