¿VBA para conectar OLEDB Connection Power Pivots?
Un placer saludarlo y a la vez aprovechar para evacuar una duda de la cual por más que he tratado de investigar no he encontrado solución alguna, quizás usted puede ayudarme.
Tengo un pequeño Proyecto de VBA como parte de mis goals en el trabajo, consiste en realizar una macro que abra 5 archivos en excel y que se actualicen.
Los archivos se corren cada lunes.
Cada archivo contiene una DB en power pivot la cual alimenta las tablas pivote.
La DB se actualiza mediante una conexión DB2 en power pivot, cada vez que se actualiza solicita user id y password por lo cual al ser 5 reportes quisiera evitar el proceso de ingresar 5 veces las credenciales colocando user id y password en una casilla y que la macro lo tome de ahí cada vez que lo requiera, esta es la parte que no he logrado, anteriormente lo ya lo había logrado pero con una conexión directa desde excel sin pasar por power pivot, pero en este caso me parece es diferente.
Este es mi código:
Sub Refresh()
''Declaración de variables
'Update Reports
UID = Sheets("Update").Range("C10").Value
Pass = Sheets("Update").Range("C11").Value
Rdate = Format(Now - 7, "mm-dd-yy")
For i = 1 To 5
Select Case i
Case 1
FileY = "Service Metrics-Detail - W Apparel & W Signature (" & Rdate & ").xlsm"
Case 2
FileY = "Service Metrics-Detail - M Apparel & M Signature (" & Rdate & ").xlsm"
Case 3
FileY = "Service Metrics-Detail - Kids, Travel , M+W Access & M+W Outerwear (" & Rdate & ").xlsm"
Case 4
FileY = "Service Metrics-Detail - Home & M+W Footwear (" & Rdate & ").xlsm"
Case 5
FileY = "Service Metrics-Detail - Sporting Equipment (" & Rdate & ").xlsm"
End Select
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & FileY
Workbooks(FileY).Activate
ActiveWorkbook.Sheets("Style - Mth").Select
With ActiveWorkbook.Connections("Custom").OLEDBConnection
.ADOConnection = _
"Provider=IBMDADB2.DB2;Persist Security Info=True;User ID=" & UID & ";Password=" & Pass & ";Data Source=LLB01DSS;Location=;Extended Properties="
.Refresh
End With
ActiveWorkbook.RefreshAll
Select Case i
Case 1
FileY = "Service Metrics-Detail - W Apparel & W Signature "
Case 2
FileY = "Service Metrics-Detail - M Apparel & M Signature "
Case 3
FileY = "Service Metrics-Detail - Kids, Travel , M+W Access & M+W Outerwear "
Case 4
FileY = "Service Metrics-Detail - Home & M+W Footwear "
Case 5
FileY = "Service Metrics-Detail - Sporting Equipment "
End Select
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & FileY & " (" & Format(Now, "mm-dd-yyyy") & ")")
ActiveWorkbook.Close
Next i
Workbooks("Service Metric-Detail Update.xlsm").Activate
Sheets("Update").Range("C10:C11").ClearContents
MsgBox ("Reports updated, please continue with the revision part for each report!")
End Sub
Cualquier tipo de ayuda se la agradecería bastante.