ExcelBanter

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/sh...d.php?t=193439

http://www.thecodecage.com/forumz