I've been following articles and questions about converting VBA to VBScript but I'm now stuck. The following code still works in VBA (if I remove the Sub routine call) but it won't run as a script.
The code opens a connection to SQL Server to check a table to see if the process has already run today and loads the result into a Recordset. If the field is set to No then it opens up an Excel workbook and runs a macro. It works in VBA but when I run the same code as a script nothing happens (no errors either).
Can you see what the problem is? Thanks very much.
NB. There are two lines for cmd.CommandText. The commented out line is designed to always return No for testing purposes only.
' Author Steve Wolstencroft
' Inititates the Automated Excel Refresh Procedure
Option Explicit
Pivot_Refresh
Public Function ConnectToSQLDwarfP()
On Error Resume Next
ConnectToSQLDwarfP = "Driver={SQL Server Native Client 10.0};Server=DwarfP;Database=DwarfPortable;Trusted_Connection=yes;"
End Function
Public Sub Pivot_Refresh()
On Error Resume Next
Dim cnx
Dim Rst
Set cnx = New ADODB.Connection
cnx.ConnectionString = ConnectToSQLDwarfP
cnx.Open
Dim cmd
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "Select Case When max(DwarfPortable.dbo.fn_GetJustDate(pl.StartDateTime)) = DwarfPortable.dbo.fn_GetJustDate(getDate()) Then 'Y' Else 'N' End as RunToday From ProcessControl.dbo.ProcessLog pl Where pl.ProcessName = 'Excel_Auto_Refresh'"
'cmd.CommandText = "Select Case When max(pl.StartDateTime) = DwarfPortable.dbo.fn_GetJustDate(getDate()) Then 'Y' Else 'N' End as RunToday From ProcessControl.dbo.ProcessLog pl Where pl.ProcessName = 'Excel_Auto_Refresh'"
Set Rst = cmd.Execute
Dim objXL, objBook
Set objXL = CreateObject("Excel.Application")
If Rst.Fields("RunToday") = "N" Then
Set objBook = objXL.Workbooks.Open("\\nch\dfs\SharedArea\HI\Clinical-Informatics\InfoRequestOutputs\Regular-Jobs\Pivot-Refresh\Pivot-Refresh-Control.xls", 0, True)
objXL.Application.Visible = True
objXL.Application.Run "'Pivot-Refresh-Control.xls'!Auto_Refresh"
objXL.ActiveWindow.Close
objXL.Quit
Set objBook = Nothing
Set objXL = Nothing
End If
End Sub
You can't instantiate external objects in VBScript with e.g. New ADODB.Connection because there are no references to external libraries.
You can't use constants like adCmdText either. They will be treated as undefined empty variables.
You don't get any errors because you shut them up with On Error Resume Next. Remove that and you will get your errors.
Make sure all external object instantiation is done with CreateObject like you are doing for Excel, and replace all external constants with their literal values.
Related
I am getting a runtime error:
-2147217900 "Invalid SQL statement" on this line of my code:
Call objRecordset.Open("frmTotalInventory", , , adLockBatchOptimistic)
I have this same code working in another MS Access project and the only difference is the form that it is referencing which is "frmTotalInventory".
I checked and the library references match between the two Access projects and I am not sure at all why I would be getting an SQL statement error. The other Access project has "InventoryForm" as the form referenced for the Recordset.Open if that helps. Full code listed below. If anyone has any ideas please let me know. Is frm a reserved word?
Option Compare Database
Private Sub Command1_Click()
On Error GoTo ErrorHandlerCall
GoTo ProgramStart 'Skip over error handling until needed
'******************
ErrorHandlerCall: '**ERROR HANDLING**
Call Error.ErrorHandler(ByVal workbook) '******************
ProgramStart:
'Open file dialog opens and returns the selected filepath from OpenFile module
Call OpenFileDialog(FilePath)
'Reset progress bar and progress label to 0
'so each time you import the values will reset
PB1 = 0
ProgressPercent.Caption = 0 & "%"
Dim ExcelApp As Excel.Application
Set ExcelApp = CreateObject("Excel.Application")
Set workbook = ExcelApp.Workbooks.Open(FileName:=(FilePath))
'This is needed to add records with VBA
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("frmTotalInventory", , , adLockBatchOptimistic)
'Loop runs within the LastRowFinder module to determine
'the last row used in the formatted workbook
Call GetLastRow(ByVal workbook, LastRowUsed)
'Math - This has to be after the "Call GetLastRow" in order for it to return
'the LastRowUsed variable that is used for calculating progress
Dim PbIncrement As Variant
PbIncrement = 1 / LastRowUsed
PbIncrement = Round(PbIncrement, 6) * 100
Call AddRecordsLoop(ByVal objRecordset, ByVal workbook, LastRowUsed, PbIncrement)
'Ensures progress bar is at 100% after adding all records
PB1 = 100
ProgressPercent.Caption = Round(PB1, 0) & "%"
'Close Excel Process
If Not (ExcelApp Is Nothing) Then ExcelApp.Quit
End Sub
Well I could not feel more stupid. This entire time I did not realize I was referencing the form instead of a table.. the names had me confused between my two projects as the one I am working on was not created by me. Thank you for making me realize how dumb someone can actually be.
The solution was to change "frmTotalInventory" to "tblInventoryList" which is the name of the actual TABLE I was trying to reference.
Is there a way to create a button in Excel that runs a query, that is already created, in Access, and then updates the excel spreadsheet using the data from the query? I've searched the web for directions on how to do this, but have only found answers that create a button in Excel, that only runs a query in Excel, not Access. I am assuming this will be done by coding, upon click, in VBA, but have yet to find anything that does this. So... Is it possible? If so, how?
Okay, so I have kind of updated this with question, because I sort of used both options made. So I first created a Function in a Standard Module (Because we may use this later for another sheet in the workbook, and we didn't want to duplicate work):
Function GetSqlServerData(sQuery As String, sRange As Range)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
' Create the connection string.
sConnString = "NMS"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute(sQuery)
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets(3).Range("A2").CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Function
Then I tried to use said function:
Sub GetPermits()
Dim sQuery As String
Dim sRange As Range
Set sQuery = "Select * From Customer;"
Set sRange = Sheets(3).Range("A2")
GetSqlServerData(sQuery, sRange)
End Sub
But it gives me an error right at the spot where is actually use the function. I don't need it to go to a MsgBox, and I don't need it to print it out, all I need is for it to put in the data into the sheet noted on the function call. BTW, the function needs some tweeking, I know. Right now, I just need it to call the darn thing, lol.
Here is a Screen Shot of the error message: If you cant see it, it says, "Compile Error: Expected:=" and it highlights the "GetSqlServerData(sQuery, sRange)" in red. So it must have something to do with that. I just can't figure out what it is.
Screenshot of the error message
Dependent on your requirements, you could have this without VBA in a quicker and more reliable way, to have a table that is pointed at your query, that updates when you click Refresh.
To do so, in Excel navigate to Data > From Access.
From here, navigate to your database with the saved query, and when asked to select a table, you can select the query instead.
You can also write your own SQL query for Excel to execute against the database instead.
You can edit the connection properties to refresh when the workbook is opened, or refresh when every 60 minutes for example, or you could turn it all off, and allow the user to hit 'Refresh' in Excel itself.
Alternatively, you could setup a button that runs the refresh table command against the linked table, and this would do the same
Private Sub CommandButton1_Click()
ActiveWorkbook.RefreshAll
End Sub
Good luck.
As an example for a solution with VBA using ADODB one could use the following function to connect to the database.
Function ConnectToDB(ByVal fileName As String)
Dim conn As New ADODB.Connection
If Dir(fileName) = "" Then
MsgBox "Could not find file " & fileName
Exit Function
End If
Dim connectionString As String
' https://www.connectionstrings.com/access/
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" _
& fileName & ";Persist Security Info=False;"
conn.Open connectionString
Set ConnectToDB = conn
End Function
And if you want to copy data from the database one could use the following code. You need to have a sheet with the codename shRepAllRecords
Option Explicit
Sub ReadFromDB()
' Get datbase name
Dim dbName As String
dbName = <fule filename of the database>
' Connect to the databse
Dim conn As ADODB.Connection
Set conn = ConnectToDB(dbName)
' read the data
Dim rs As New ADODB.Recordset
Dim query As String
' First example to use an SQL statement
' query = "SELECT * From CUSTOMER"
' Second example to use a query name defined in the database itself
query = "qryCustomer"
rs.Open query, conn
' shRepAllRecords is the codename of the sheet where the
' data is written to
' Write header
Dim i As Long
For i = 0 To rs.Fields.Count - 1
'shRepAllRecords.Cells(1, i + 1).Value = rs.Fields(i).Name
shRepAllRecords.Range("A1").Offset(0, i) = rs.Fields(i).Name
Next i
' Write Data
shRepAllRecords.Range("A2").CopyFromRecordset rs
shRepAllRecords.Activate
' clean up
conn.Close
End Sub
So I was finally able to figure out the issue. I was not putting "Call" in front of the function call. Once I did that, it accepted it. Thanks for all the assistance! The final answer was close to what Storax gave above. So I credited him with the answer. Thanks again!
Im making a macro on excel that import data from MySQL (with querytables.add and using OBCD) and every time i run the macro it creates a new connection and its a waste of time and space. Is there a function to know if a cell/sheet has a connection on it so i dont have to import the data again and create a new connection or a code to know when was the last time the connection was refreshed.
i looked up for something but it seems there is nothing like it, so maybe and alternative way to do it will be useful, thanks!
Code:
Worksheets("Hoja1").Activate
Dim sqlstring As String
Const connstring As String = "ODBC;DSN=blabla;UID=blabla;PWD=blabla"
if "***Range("A1") has a connection***" then
ActiveWorkbook.Connections("Conexión").Refresh 'actualize the connection previously made
Else 'import the table from sql server
sqlstring = vbNullString
sqlstring = "SELECT * FROM ExTable WHERE year > '2012'"
With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), Sql:=sqlstring)
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False
End With
I just built and tested this nifty little procedure that checks if a connection exists for a specific worksheet range and if so, refreshes it. I also left a spot to add the part where it creates a new one if it's not found.
Warning - as written, this will potentially fail if there is another connection listed on the worksheet outside the desired range and it checks that connection first while there is also an existing connection within the desired range. You'll need to adjust for that.
Sub RefreshMakeConnection()
Dim cnT As Connections
Set cnT = ThisWorkbook.Connections
Dim sWS As String
sWS = "Hoja1"
Dim cn As WorkbookConnection
For Each cn In cnT
If cn.Ranges(1).Parent.Name = sWS Then
With Worksheets(sWS)
If Not Intersect(.Range("A1"), cn.Ranges(1)) Is Nothing Then
cn.Refresh
Else
'code to create new connection
End If
End With
End If
Next
End Sub
Perhaps you may find the connections name?
Sub test()
Dim ItemConnection As Variant
Dim TotalConnections As Connections: Set TotalConnections = ThisWorkbook.Connections
For Each ItemConnection In TotalConnections
MsgBox ItemConnection.Name
Next ItemConnection
End Sub
PS: Variant is because I didn't find a way to declare connection as a single item of connection
I'm trying to import some data from an Access .MDB file into an Excel 2013 spreadsheet.
So far, I've tried converting the database to 2007 format but that hasn't worked (2 methods I've tried so far)
Is there a simpler way of importing data straight from a table in the .MDB file into a sheet in my Excel 2013 spreadsheet? (End result)
Sub convertaccessdb()
Application.ConvertAccessProject _
SourceFilename:="C:\new\pabxcalls.mdb", _
DestinationFilename:="C:\My Documents\pabxcalls2007.accdb", _
DestinationFileFormat:=acFileFormatAccess2007
End Sub
' **** THIS GIVES AN RUNTIME ERROR 438 - OBJECT DOESN'T SUPPORT THIS PROPERTY OR METHOD ***
And
Sub Command7_Click()
Dim app As New Access.Application
app.Visible = True
app.AutomationSecurity = msoAutomationSecurityLow
app.SysCmd 603, "C:\New\pabxcalls.mdb", "C:\new\pabxcalls_new.mdb"
Set app = Nothing
End Sub
' *** THIS RUNS, BUT DOES NOT OUTPUT THE FILE REQUIRED ***
Thanks guys!!!
Found out that I didn't actually have to convert the database. Simply pull data using a query and ADODB connection, as follows.
Thanks anyway!
Sub GetCallData()
Dim objAdoCon As Object
Dim objRcdSet As Object
Dim DailyOutgoing, DailyIncoming, MonthlyOutgoing, MonthlyIncoming As String
DailyOutgoing = "SELECT calls.Extension,Sum(calls.Duration) FROM calls WHERE (((calls.Calldate)=Date())) AND (((calls.calltype)=""O"")) GROUP BY calls.Extension, calls.Calldate ;"
DailyIncoming = "SELECT calls.Extension,Sum(calls.Duration) FROM calls WHERE (((calls.Calldate)=Date())) AND (((calls.calltype)=""I"")) GROUP BY calls.Extension, calls.Calldate ;"
Set objAdoCon = CreateObject("ADODB.Connection")
Set objRcdSet = CreateObject("ADODB.Recordset")
objAdoCon.Open "Provider = Microsoft.Jet.oledb.4.0;Data Source = \\remotehost\PABXSoft\Call Collector\Data\pabxcalls.mdb"
' *** GET DAILY OUTGOING ***
ThisWorkbook.Worksheets("CALL_DATA").Range("A3:B24").Value = ""
objRcdSet.Open DailyOutgoing, objAdoCon
ThisWorkbook.Worksheets("CALL_DATA").Range("A3").CopyFromRecordset objRcdSet
Set objRcdSet = Nothing
' *** GET DAILY INCOMING ***
Set objRcdSet = CreateObject("ADODB.Recordset")
ThisWorkbook.Worksheets("CALL_DATA").Range("A27:B46").Value = ""
objRcdSet.Open DailyIncoming, objAdoCon
ThisWorkbook.Worksheets("CALL_DATA").Range("A27").CopyFromRecordset objRcdSet
Set objAdoCon = Nothing
Set objRcdSet = Nothing
End Sub
I have a shared, protected workbook that has a button to bring up a search form. There are two fields on this form, txtYear and cbxRegion, that I need enabled. Whenever I try to open the fields, it works until I exit Excel.
I have tried unprotecting the workbook, unsharing it, and commenting out any reference in the VBA to reprotecting the form. And still, even the edited VBA reverts back to the original.
This is the section of code referring to the form I need enabled. Any assistance would be greatly appreciated. I'm using Excel 2010.
Private Sub UserForm_Initialize()
Dim strDb As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim row As Integer
Dim AccessVersionID As String
cbxRegion.Value = Worksheets("Parameters").Cells(5, 14)
Me.txtYear = Worksheets("Parameters").Cells(4, 7)
Me.chkBoth = Worksheets("Parameters").Cells(9, 2)
Me.chkConsultant = Worksheets("Parameters").Cells(7, 2)
Me.chkInHouse = Worksheets("Parameters").Cells(8, 2)
'Set region values
'Open connection
'Select Case SysCmd(acSysCmdAccessVer)
'Case 11: AccessVersionID = "2003"
'End Select
'If AccessVersionID = "2003" Then
' strDb = Worksheets("Parameters").Cells(17, 2).Value 'This will reference the path
'Else
strDb = Worksheets("Parameters").Cells(18, 2).Value
'End If
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDb & ";"
Set rs = New ADODB.Recordset
'Get recordset
With rs
Set .ActiveConnection = cn
.Open "Select * From LookupRegion"
.Requery
End With
'Add regions
row = 0
With rs
.MoveFirst
Do Until .EOF
cbxRegion.AddItem ![region]
cbxRegion.list(row, 1) = ![RegionName]
row = row + 1
.MoveNext
Loop
End With
'Close the recordset
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I managed to get it to work. In order, I:
Unshared the workbook
Unprotected the workbook
Saved, closed, and reopened the workbook to make sure the settings stayed
Enabled the fields
Saved, closed, and reopened the workbook to make sure the settings stayed
Protected the workbook
Shared the workbook (as required by the specifications I was given, I would rather not share it but it really isn't my call here)
Saved, closed, and reopened the workbook to make sure the settings stayed
And now it works exactly as I need it to.
As far as I am concerned, the best advice anyone can give you for a shared workbook is: don't use them.
Shared Workbooks are impossible to troubleshoot. Their aberrant behaviour cannot be fixed. They don't follow any logic. Once a shared workbook starts acting up and behaving strangely, you have reached the inevitable end stage. Nothing can be done to fix it. The behaviour is not necessarily reproducible.
If you need simultaneous multi-user write access to a dataset, then Excel is the wrong tool. Use a database.
Don't use shared workbooks.