ODBC

Prev: Disable PDF add-in
Next: Cut and paste to new sheet

From: ODBC Help ODBC on 6 Apr 2010 15:44

---

Hi Gurus

Does any version facilitates creation of ODBC connection to read multiple
excel sitting in a folder than only to one workbook?

Regards,

Pratik

From: Ron de Bruin on 6 Apr 2010 17:23

---

Maybe ?
http://www.rondebruin.nl/ado.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm



"ODBC Help" <ODBC Help(a)discussions.microsoft.com> wrote in message news:E53F448D-626C-44D2-865F-5BFDDCA849D0(a)microsoft.com...
> Hi Gurus
>
> Does any version facilitates creation of ODBC connection to read multiple
> excel sitting in a folder than only to one workbook?
>
> Regards,
>
> Pratik
>

From: joel on 6 Apr 2010 17:33

---

I took some code that I wrote a while back and modified to loop through
a folder. the looping is simple

Folder = "c:\Temp\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""

DestFile = Folder & FName
Set cn = New ADODB.Connection

With cn

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Mode=Share Deny None;" & _
"Extended Properties=""Excel 8.0;HDR=No;ReadOnly=False;"""

.Open (ConnectStr)
End With

'excel worksheet must have dollar sign at end of name
DestShtName = "Sheet1" & "$"

'open the recordset
Set rs = New ADODB.Recordset
With rs
MySQL = "SELECT * FROM [" & DestShtName & "] "

.Open Source:=MySQL, _
ActiveConnection:=cn

'-------------------------------------------------------
'enter your code here
'-------------------------------------------------------

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

FName = dir()
loop


------------------------------------

Sub MoveFolder()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Set sourcesht = ThisWorkbook.Sheets("Sheet1")
Folder = "c:\Temp\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""

DestFile = Folder & FName
'excel worksheet must have dollar sign at end of name
DestShtName = "Sheet1" & "$"

With sourcesht
Person = .Range("A1")
EstWorkLoad = .Range("C4")
RealWorkLoad = .Range("C5")
WeekNum = .Range("F2")
End With

'open a connection, doesn't open the file
Set cn = New ADODB.Connection

With cn

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DestFile & ";" & _
"Mode=Share Deny None;" & _
"Extended Properties=""Excel 8.0;HDR=No;ReadOnly=False;"""

.Open (ConnectStr)
End With

'open the recordset
Set rs = New ADODB.Recordset
With rs

MySQL = "SELECT * FROM [" & DestShtName & "] "

.Open Source:=MySQL, _
ActiveConnection:=cn

If .EOF <> True Then

RowCount = 1
Do While Not .EOF And RowCount < 14

.MoveNext
RowCount = RowCount + 1
Loop

If .EOF Then
MsgBox ("Not Enough Rows - Exit macro")
End If

setLoad = ""

WorkWeekCol = 0
WorkWeek = 22
For Each Fld In rs.Fields
If Fld.Value = WorkWeek Then
'rows and columns are backwards from excel
WorkWeekCol = Range(Fld.Name).Row
Exit For
End If
Next Fld
End If

If WorkWeekCol = 0 Then
MsgBox ("Did not find WorkWeek : " & _
WorkWeek & ". Exiting Macro")
Exit Sub
End If

.Close

Person = "Joel"

MySQL = "SELECT *" & vbCrLf & _
"FROM [" & DestShtName & "] " & vbCrLf & _
"Where [" & DestShtName & ".F1]='" & Person & "'"

.Open Source:=MySQL, _
ActiveConnection:=cn, _
LockType:=adLockOptimistic, _
CursorType:=adCmdTable

If .EOF = True Then
MsgBox ("count not find : " & Person & " Exit Macro")
Exit Sub
Else

EstWorkLoad = 123
RealWorkLoad = 456
'field start at zero, subtract one from index
.Fields(WorkWeekCol - 1).Value = EstWorkLoad
.Fields(WorkWeekCol).Value = RealWorkLoad
.Update
End If


End With

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

FName = Dir()
Loop
End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=193439

http://www.thecodecage.com/forumz

 | 
Pages: 1
Prev: Disable PDF add-in
Next: Cut and paste to new sheet