Hi I am working in a excel file with 46 pivot tables. The code below changes the connection of each pivot table to a new existing connection.
Sub changeConnection()
Dim pTable As Variant
Dim sheet As Variant
Dim workBookName As String
workBookName = "filename.xlsm"
For Each sheet In Workbooks(workBookName).Worksheets
For Each pTable In sheet.PivotTables
pTable.changeConnection Workbooks(workBookName ).Connections("connection name")
Next pTable
Next sheet
End Sub
I want everything to stay the same for my pivot tables but I want a password on the file that I am connected to. Since excel can not do this I used ADO to access a password protected excel file.
Public Function readFile()
Dim xl As Object
Dim conn As New ADODB.connection
Dim recSet As ADODB.Recordset
Dim conString As String
Dim wkbName As String
Dim SQL As String
Dim DBPath As String
'Path to excel file
DBPath = "path\to\file.xlsm"
Set xl = GetObject(DBPath)
'Name of table
wkbName = "[IS$]"
conString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
'Query
SQL = "select * from " & wkbName
'Open connection
conn.Open conString
'Itterate over record set
Set recSet = New ADODB.Recordset
recSet.Open SQL, conn
'Print out col1 from table
Do Until recSet.EOF
'process your data here
Debug.Print recSet!ISData
recSet.MoveNext
Loop
End Function
The code above will access a table inside of the password protected workbook stored externally. Then using a record set print out in debug all the items.
I want to essentially use my workaround in the second snippet of code so I can replace all my pivot table connections so my data source can have a password on it. All my pivot tables point to the same connection so using the same connection won't cause issues.
Thank in advance and please comment if I should clarify anything.
IIR there isn't a data provider that can do this. That driver will give an error to the effect of “could not decrypt file” even if you attempt to store the password in the connection string.
The second bit of code is basically a hack to get around this and it relies on Excel to manage the credential prompt from the user. It does not solve the fact that you can't supply a password in your connection string - it is a work-around. Given that you can't supply a connection string that works to ADO, you're not going to be able to supply it to the stored connection string either.
I would suggest using an actual database for the back end instead of an Excel file. This will give you much more flexibility in managing user access.
Related
You've help me to get to this point and now I'm stuck again. The macro works fine, but only one person can run it at any given time. If two users try to run it at the same time, they get a Runtime error. When I click Debug, it takes me to "myConn.Open"
To clarify, I'm not trying to allow multiple users to edit the Excel spreadsheet. They are only opening it read-only to get values from it, not to add or edit it in any way.
Public Sub Letter()
Dim rngStory As Word.Range
Dim rngCount As Long
Dim mySQLquery As String
Dim myKey As String
Dim mySource As String
Dim slkAddresseeName, slkRegarding, slkFileNum, slkSalutation As String
Dim slkTemplate As String
Dim myConn As ADODB.Connection
Dim myRs As ADODB.Recordset
Dim slkTempDoc As String
' Prompt user for Login ID
myKey = InputBox("Enter Attorney or Paralegal LOGIN ID (e.g., jtorres or b324):")
' Make DB connection
mySQLquery = "SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
mySource = "\\servername\vol1\macros\master\LetterMemoDB.xlsx"
Set myConn = New ADODB.Connection
Set myRs = New ADODB.Recordset
With myConn
.Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" & mySource & ";Extended Properties=""Excel 8.0;HDR=YES"";"
End With
myConn.Open
myRs.Open mySQLquery, myConn, adOpenStatic, adLockReadOnly
' End of DB connections
My guess is I'm using ACE as the provider and maybe it can't support multiple, simultaneous connections. What's the fix?
Fix was to change the Excel file to read-only via right click | Properties. Sorry for the stupid question.
Im trying to update an Access database with new code to add to one aggregate list of scan entries. The macro needs to open the access file, copy the range from excel and paste it at the bottom of the database to add to the already existing records. Then save the access .accdb file and then close. Any tips particularly on the copying and pasting data portion?
Use ACE.OLEDB. Create an SQL INSERT STATEMENT. Code would look something like below:
Sub Test()
accessFilePath = "C:\someDB.accdb"
Call ExecuteSQLCmd("INSERT INTO `" & accessFilePath & "`.`Table` (col1,col2,col3) SELECT col1,col2,col3 FROM [Sheet1$]", accessFilePath)
End Sub
Sub ExecuteSQLCmd(cmd As String, accessFilePath as String )
Dim cnn As ADODB.Connection
Dim sql As String
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accessFilePath & ";Persist Security Info=False;"
If Not (cnn Is Nothing) Then
'Execute Sql
cnn.Execute (cmd)
'Close
cnn.Close
End If
Set cnn = Nothing
End Sub
I am new to using VB alongside Excel and am in need of help.
I have an two access databases; one having 10 columns with many rows (more than 10), and the other Database has 8 columns and the same amount of rows as the other.
What I am trying to do is to export the first 10 rows of both databases to an excel sheet (in separate sheets or in two separate excel files, either way) so that this could be emailed or printed.
I've been looking around trying to get an idea on how to do this and have tried a few ways of doing it but none of them have worked.
Additionally I'll be fine if someone can help with exporting one database through VB with the first 10 rows of the database.
Could someone please help me.
Thanks,
Andy
Assuming this is something like an Import Data button in Excel, you probably want to use ADODB to connect to your access databases, select data into a recordset, then read the recordset into an array and assign to the worksheet you want to import to (optionally at the end of existing data - this depends on whether you're importing "10 more rows" or refreshing the top 10 rows (whatever that means - guessing you have a query to get these in Access, though).
Approach would look something like this. Oh, before we begin, you'll need to add a reference (Tools -> References) to Microsoft ActiveX Data Objects 6.1.
Public Sub Test()
Dim strSQL_Query As String
Dim oCN As ADODB.Connection
Dim oCMD As ADODB.Command
Dim oRecords As ADODB.Recordset
Dim strCN As String
Dim strDBPath As String
Dim varValues As Variant
Dim wksTarget As Excel.Worksheet
Dim lngRows As Long
Dim lngCols As Long
'' Replace with the path to your DB. You could also use a dialog box to let the user choose a DB, if
'' it moves around or isn't found.
strDBPath = "C:\myFolder\myAccessFile.accdb"
strCN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBPath & ";" & _
"Persist Security Info=False;"
'' Replace this with a query that does what you need it to
strSQL_Query = "SELECT TOP 10 FROM [MyTable] WHERE <Conditions> ORDER BY [Column] DESC"
Set oCN = New ADODB.Connection
oCN.ConnectionString = strCN
oCN.Open
Set oCMD = New ADODB.Command
oCMD.ActiveConnection = oCN
oCMD.CommandText = strSQL_Query
Set oRecords = oCMD.Execute
If oRecords.BOF And Not oRecords.EOF Then
varValues = oRecords.GetRows
Set wksTarget = ThisWorkbook.Worksheets(1)
'' You might need 0 and 1 instead of 1 and 2 - I forget
lngCols = UBound(varValues, 1)
lngRows = UBound(varValues, 2)
wksTarget.Range("A1", wksTarget.Range("A1").Offset(lngRows, lngCols)) = varValues
End If
'' Clean up...
Set oRecords = Nothing
Set oCMD = Nothing
oCN.Close
Set oCN = Nothing
'' Do Some more stuff...
'' And finish by saving the workbook
'' 1) Check if the directory exists and create it
Dim strDir as String
strDir = "C:\Some\Path\Here"
If Dir(strDir, vbDirectory) = "" Then MkDir(strDir)
ThisWorkbook.SaveAs strDir & "YourWorkbookName.xlsm", 52 '' 52 is a constant indicating a macro enabled format
End Sub
Any help with this issue is greatly appreciated.
I am trying to retrieve from Access, by means of Select, multiple values with the same ID and have it pasted into an Excel sheet. I am running the code from Excel VBA.
The query I am using to retrieve said values is:
SELECT Role
FROM Roles
WHERE App_ID=(SELECT ID FROM Apps WHERE NAME='app name');
which is assigned to a variable and afterwards executed by using Set variable = cn.Execute(variable). The problem is that this query, executed from Excel VBA, returns only the first value found. Now, if I run this query from Access it returns every value with the ID for the specified app.
I have tried tried using INNER JOIN, IN, HAVING, etc. but it just wont retrieve all of the values into Excel. Like I said, the query works fine when used in Access so I know this must be limitation in Excel.
Thank you for any help you guys can provide.
Assuming you are using ADODB in Excel, keep in mind that the Execute function returns a Recordset. You can loop through the Recordset to see the additional rows.
Set rng = ActiveSheet.Range("A2")
Set rst = cn.Execute(strSQL)
With rst
Do While Not .EOF
rng = CStr(!Role)
Set rng = rng.Offset(1)
.MoveNext
Loop
End With
'Applies to Access 2010
'Reference Microsoft ActiveX Data Objects 6.1 Library
Dim strSQL As String
Dim strDBPathName As String
Dim strConProvider As String
Dim strPersist As String
Dim conADODB As ADODB.Connection
Dim rsADODB As ADODB.Recordset
Set conADODB = New ADODB.Connection
strConProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
'Database path name
strDBPathName = "Data Source=C:\Temp\Database.accdb;"
strPersist = "Persist Security Info=False;"
With conADODB
.ConnectionString = strConProvider & strDBPathName & strPersist
.Open
End With
strSQL = "SELECT Role FROM Roles WHERE App_ID=(SELECT ID FROM Apps WHERE NAME='app name')"
Set rsADODB = New ADODB.Recordset
With rsADODB
.Open strSQL, conADODB, adOpenStatic, adLockPessimistic
If Not (.EOF And .BOF) Then
'Range of spreadsheet to paste records
Cells(1, 1).CopyFromRecordset rsADODB
End If
.Close
End With
Set rsADODB = Nothing
conADODB.Close
Set conADODB = Nothing
Let's skip to the command text box on the definitions tab of the connection properties.... my command type is SQL.
I can execute spDuplicatesAnalysis from within SSMS. I have tried a numbee things with no luck, including ...
exec spDuplicatesAnalysis
dbo.spDuplicatesAnalysis
So how should the actual command txt read ?
Thx!
Calling stored procedures from Excel VBA
Open a new Excel workbook
Name one of the tabs "Data" (or change the code below)
Open the VB Editor (Alt+F11)
Add a new module
Set a reference to Microsoft ActiveX Data Objects (choose highest version number available)
Add the following code to your module
Sub ExecStoredProcedureFromExcelVBA()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim connectString As String
Dim custState As String
Dim tgt As Worksheet
Set tgt = ThisWorkbook.Sheets("Data")
custState = "TX"
' Clear the target worksheet
tgt.UsedRange.Clear
' Set the connection string
connectString = "Provider=SQLOLEDB;Data Source=.;" & _
" Initial Catalog=Sandbox;Integrated Security = SSPI"
' Create the adodb objects
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute the stored procedure
cn.Open connectString
cn.spGetCustomersForState custState, rs
' Check for results
If rs.state = 1 Then
If Not rs.EOF Then
' Write the contents of the recordset to our target
tgt.Range("a1").CopyFromRecordset rs
rs.Close
End If
End If
' Clean up after ourselves
If CBool(cn.state And adStateOpen) Then cn.Close
Set cn = Nothing
Set rs = Nothing
End Sub
Modify the module to reference the database, stored procedure, and parameters you want to work with
Run the code