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