Hi, I'm hoping someone can help me.
I'm trying to write a macro import data from a master spreadsheet held
on our LiveLink DMS.
It needs to autorun for any person opening the workbook on any
machine. I used to have it working when the master was held on a
normal groupdrive, but since the file has moved to onto LiveLink I'm
getting errors (general odbc - debug pointing at
backgroundrefresh=false). I think it's down to the connection timing
out.
I can't find any documentation on how to connect to a file using an
http/webdav address. I've tried using a direct node/filename address,
but using that address is very slow and I presume that's the reason
why the macro doesn't like it. I'd prefer to use webdav - it's easier
to get the link and is significantly faster.
I've tried recording a macro using the webdav address (IMport data >
Enter the webdav address as file name > click open > select
worksheet), but the recorded macro shows it using temp files on my
profile on my machine. I need this to run happily irrespective of the
machine or user (the file will be on the company portal).
I'm really not good at understanding data importing. should I use ADO,
ODBC, OLAP? Should I specifiy a new source and, if so, what do I use
for that. everything I've found so far either relates to using drive
letters or connecting directly into a database. I can't find anything
on opening a file via http.
The rough code I've got so far (slightly anonymised)...
Sub Auto_Open()
Sheets("Group A Data").Select
PreImport
GrpAPosDataImport
PostImport
Sheets("Group B Data").Select
PreImport
GrpBPosDataImport
PostImport
ActiveWorkbook.Save
Sheets("Summary").Range("A1").Select
End Sub
------
Private Sub PreImport()
ActiveWindow.FreezePanes = False
With ActiveSheet
.Cells.EntireColumn.Hidden = False
.AutoFilterMode = False
.Cells.Clear
End With
End Sub
------
Private Sub GrpAPosDataImport()
Dim DivString As Variant
Range("A1").FormulaR1C1 = "Group A Data"
Range("A3").Select
DivString = "SELECT `Grps$`.`Org`, `Grps$`.`Position`, `Grps
$`.`Band`, `Grps$`.`Status`, `Grps$`.`First Name`, `Grps$`.`Last
Name`, `Grps$`.`Business Number`, `Grps$`.Location" & Chr(13) & "" &
Chr(10) & "FROM `Grps$` `Grps$`" & Chr(13) & "" & Chr(10) & "WHERE
(`Grps$`.Division Like 'Group A%')" & Chr(13) & "" & Chr(10) & "ORDER
BY `Grps$`.`Org`, `Grps$`.`Org Unit Number`, `Grps$`.`Status`, `Grps
$`.`Band` DESC, `Grps$`.`Last Name`"
CreateImport
End Sub
------
Private Sub GrpBPosDataImport()
Dim DivString As Variant
Range("A1").FormulaR1C1 = "Group B Data"
Range("A3").Select
DivString = "SELECT `Grps$`.`Org`, `Grps$`.`Position`, `Grps
$`.`Band`, `Grps$`.`Status`, `Grps$`.`First Name`, `Grps$`.`Last
Name`, `Grps$`.`Business Number`, `Grps$`.Location" & Chr(13) & "" &
Chr(10) & "FROM `Grps$` `Grps$`" & Chr(13) & "" & Chr(10) & "WHERE
(`Grps$`.Division Like 'Group B%')" & Chr(13) & "" & Chr(10) & "ORDER
BY `Grps$`.`Org`, `Grps$`.`Org Unit Number`, `Grps$`.`Status`, `Grps
$`.`Band` DESC, `Grps$`.`Last Name`"
CreateImport
End Sub
------
Private Sub CreateImport()
Dim SQLString As Variant
SQLString = DivString
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=\\share\sharedav\nodes
\1621110\Position_Report.xls;DefaultDir=\\share\sharedav\nodes
\1621110\;DriverId=790;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("A3"))
.CommandText = StringtoArray(SQLString)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
-----
Function StringtoArray(Query As Variant) As Variant
Const StrLen = 127
Dim NumElems As Integer
Dim Temp() As String
NumElems = (Len(Query) / StrLen) + 1
ReDim Temp(1 To NumElems) As String
For i = 1 To NumElems
Temp(i) = Mid(Query, ((i - 1) * StrLen) + 1, StrLen)
Next i
StringtoArray = Temp
End Function
-----
Private Sub PostImport()
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Font.Name = "Arial"
.Font.Size = 10
End With
Range("A1").Select
With Selection
.Font.Bold = True
.Font.Size = 14
End With
Rows("3:3").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Rows("4:4").Select
ActiveWindow.FreezePanes = True
PrintSettings
Range("A3").Select
Selection.AutoFilter
Range("A1").Select
End Sub
-----
Sub PrintSettings()
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintArea = "$A:$H"
.LeftFooter = "&9&F [&A]"
.CenterFooter = "&9Page &P of &N"
.RightFooter = "&9printed on: &D &T"
.LeftMargin = Application.CentimetersToPoints(1.5)
.RightMargin = Application.CentimetersToPoints(1.5)
.TopMargin = Application.CentimetersToPoints(2)
.BottomMargin = Application.CentimetersToPoints(2)
.HeaderMargin = Application.CentimetersToPoints(1.3)
.FooterMargin = Application.CentimetersToPoints(1.3)
.PrintQuality = 600
.CenterHorizontally = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Range("A1").Select
End Sub
If anyone can help, I'd very much appreciate it.
ta
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
