Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access VBA
| Search | Today's Posts | Mark Forums Read
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #1 (permalink)  
Old September 9th, 2004, 09:35 AM
Registered User
 
Join Date: Apr 2004
Location: , , .
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts
Default access to excel automation...seem to still have a

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







Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel Automation MAKO C# 0 August 16th, 2006 01:05 PM
Automation with Access and Excel venomm Access 2 March 20th, 2005 11:34 AM
Excel Automation ameysun C# 0 November 4th, 2004 07:33 AM
Excel Automation ameysun Pro VB 6 0 November 4th, 2004 02:55 AM
Access ro Excel Automation Sample Code galefly Access VBA 2 November 30th, 2003 07:29 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.