| |
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
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | |
Share:
| |
You check for an Excel instance by using GetObject.
If an instance exists, you set a reference to it, but you don't release that
reference within that procedure.
Then in the calling procedure you re-set that reference.
I don't know for sure, but this could mess up Windows' count of how many
open references you have to Excel.
Also -
you mentioned that this hidden instance of Excel doesn't show in the
Task Manager.
If you have a version of Windows above 98, there should be a second tab on
your Task Manager named Processes. You may well see your hidden instance
there.
HTH
- Turtle
"mytfein" <an*******@devdex.com> wrote in message
news:41**********************@news.newsgroups.ws.. . 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
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | | | |
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Why don't you save yourself a lot of effort & use the Access
DoCmd.TransferText method? It reads the text file directly into Access.
Use an Import/Export specification to indicate the column names & data
types of the text file data.
Read the Access help article on TransfetText Method.
--
MGFoster:::mgf00 <at> earthlink <decimal-point> net
Oakland, CA (USA)
-----BEGIN PGP SIGNATURE-----
Version: PGP for Personal Privacy 5.0
Charset: noconv
iQA/AwUBQUD4tYechKqOuFEgEQIbwgCgyCau4TfVEm1MHnU0mgTDS/CV9aUAnjR6
vdKhOqxJalgbB4yWB3gTbDIO
=pxyk
-----END PGP SIGNATURE-----
mytfein wrote: 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 | | | |
I've had this exact same problem before. I solved it by eliminating
"implicit references". Check out the Google Groups archives for more
detail about this.
This line looks troublesome to me: ActiveWorkbook.SaveAs <blah-blah-blah>
It looks like "ActiveWorkbook" implicitly references an Excel object
(I don't remember which one and can't check cuz I fried the PC with
Office on it). | | | |
Why not just read the file with Access and skip Excel entirely?
"mytfein" <an*******@devdex.com> wrote in message
news:41**********************@news.newsgroups.ws.. . 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
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | | | |
Hi MacDermott,
Thank you for responding.....
thx for the tip about task manager/processes --
I do see excel.exe running
I do release the objExcel in another place (under CloseExcel), as the
objExcel is global.....
so I have a feeling it's another problem....
doing research on the web...it seems that using a macro recorder is a
little dangerous as a basis for access to excel script.....trying to
search on 'opentext' to see how others have accomplished this....
mytfein
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | | | |
Hi MgFoster,
The txt file has so many fields, that when I tried the transfer text,
using the import file spec,got error msg on import that could not debug.
So posted this problem on a bulletin board, and someone introduced me to
the exel opentext method, that will map out the fields....
Since that idea, worked through an excel macro, decided to use that
approach using a vba script....
so now that I have the mappings via excel, maybe I'll use that to try
the import spec again using the transfer text command....
mytfein
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | | | |
Hi Mathew,
I think you have a point....
Someone suggested that using the excel macro recorder as a basis for
writing a vba script is a little dangerous...
because of implicit references...
so I'm surfing the web for 'opentext' to see how someone would have done
the script, properly opening excel with the
objects that it needs...
mytfein
*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it! | | This discussion thread is closed Replies have been disabled for this discussion. Similar topics
2 posts
views
Thread by Darren Barrick via .NET 247 |
last post: by
|
10 posts
views
Thread by Mark Day |
last post: by
|
6 posts
views
Thread by Ecohouse |
last post: by
|
9 posts
views
Thread by Tony Williams |
last post: by
|
8 posts
views
Thread by Colleyville Alan |
last post: by
|
1 post
views
Thread by Gary Cobden |
last post: by
|
7 posts
views
Thread by taylor.bryant |
last post: by
|
6 posts
views
Thread by Matthew Wieder |
last post: by
|
12 posts
views
Thread by elziko |
last post: by
| | | | | | | | | | | | | | | | | | | |
