find files and open db

[Rivers]

hi all
i have two questions
1 how do i open a database from inside excel
2 is it possible to populate a listbox with all available files from a
specified folder i.e all files in mydocuments but not including the folders.


thanks alot

this site has helped me no end of times

 

[Dave Peterson]

#1. Do you mean you want to start your database program or import your data
from that database into an excel worksheet?

And I would think it would depend on what your database program is and even the
version of excel that you're using.

#2. Yep. But if you're creating a userform to open a file, you may want to
look at application.getopenfilename. It'll show the folders, but it's very easy
to implement.

 

[Rivers]

hi dave brilliant

my version of excell is 2003 the mdb is just to open it not link to it

the other with the list of file names in a list what im looking for is my
user to select a folder location from a list i provide and then on a
worksheet the list of filenames in that folder appear on that row im looking
for the code that can view the folder and attatch the names of the files into
an array then reverse the array back into a worksheet for the users to see.

 

[Dave Peterson]

I don't speak Access (that's the .mdb file, right), but Ron de Bruin shared
this:

Sub test()
Dim ac as object

Set ac = nothing
On Error Resume Next
Set ac = GetObject(, "Access.Application")
on Error goto 0

If ac Is Nothing Then
Set ac = GetObject("", "Access.Application")
end if
ac.OpenCurrentDatabase "C:\My Documents\db1_2K.mdb"
ac.UserControl = True
'AppActivate "Microsoft Access"
End Sub

As for getting the list of files from a folder, maybe this'll get you started.

Option Explicit
Sub testme()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))

For Each myCell In myRng.Cells
myPath = myCell.Value
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0

If myFile = "" Then
myCell.Offset(0, 1).Value = "No files!"
Else
'get the list of files for that folder
'clean up existing names
Erase myNames
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
If fCtr > (.Columns.Count - 1) Then
'it won't fit, what should happen??
MsgBox "not enough columns!"
Else
myCell.Offset(0, 1).Resize(1, fCtr).Value = myNames
End If
End If
End If
Next myCell
End With
End Sub

 

[Rivers]

hi dave your versions great the only downside is that it goes from column to
column where as i need it to go row to row. i tried changing the offsets and
the definition to rows but all i ended up with was nofiles in my rows???

i managed to get a version before your reply and it works great.....until i
select a diffrent drive to c: then it stops working altogether please find
code below. your version however was able to search my d: which is brilliant

oh and the help to open the db i needed was cool too i tried so many
diffrent types of code (followhyperlink, openapp etc) but that one does the
job perfectly

thanks dave any further help is definatly appreciated

rivers
Sub Open_All_Files()
Dim sFil, sPath, sel As String
Dim i As Integer
sPath = d:\ 'location of files
sel =xls
Range("B:B").ClearContents
ChDir sPath
sFil = Dir("*." & sel) 'change or add formats
i = 3
Do While sFil <> "" 'will start LOOP until all files in folder sPath have
been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the
file
i = i + 1
Range("b" & i) = sFil 'put filename into cell range i
sFil = Dir
Loop ' End of LOOP
End Sub

 

[Dave Peterson]

So you have the folders in Row 1 and want the filenames under each "folder
header" starting in row 2?

Option Explicit
Sub testme()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet1")
Set myRng = .Range("a1", .Cells(1, .Columns.Count).End(xlToLeft))

For Each myCell In myRng.Cells
myPath = myCell.Value
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0

If myFile = "" Then
myCell.Offset(1, 0).Value = "No files!"
Else
'get the list of files for that folder
'clean up existing names
Erase myNames
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
If fCtr > (.Rows.Count - 1) Then
'it won't fit, what should happen??
MsgBox "not enough columns!"
Else
myCell.Offset(1, 0).Resize(fCtr, 1).Value _
= Application.Transpose(myNames)
End If
End If
End If
Next myCell
End With
End Sub

==========
Even though I don't use access, I would think that automating Access is better
than just starting it via a hyperlink.

But you may want to give something like this a try.

Thisworkbook.followhyperlink "file:////C:\My Documents\db1_2K.mdb"

But you may end up getting those security prompts that you get with hyperlinks.

hi dave your versions great the only downside is that it goes from column to
column where as i need it to go row to row. i tried changing the offsets and
the definition to rows but all i ended up with was nofiles in my rows???

i managed to get a version before your reply and it works great.....until i
select a diffrent drive to c: then it stops working altogether please find
code below. your version however was able to search my d: which is brilliant

oh and the help to open the db i needed was cool too i tried so many
diffrent types of code (followhyperlink, openapp etc) but that one does the
job perfectly

thanks dave any further help is definatly appreciated

rivers
Sub Open_All_Files()
Dim sFil, sPath, sel As String
Dim i As Integer
sPath = d:\ 'location of files
sel =xls
Range("B:B").ClearContents
ChDir sPath
sFil = Dir("*." & sel) 'change or add formats
i = 3
Do While sFil <> "" 'will start LOOP until all files in folder sPath have
been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the
file
i = i + 1
Range("b" & i) = sFil 'put filename into cell range i
sFil = Dir
Loop ' End of LOOP
End Sub

 

[Dave Peterson]

I'm not sure what you really want--a list in a worksheet or the ability to open
all the files in a folder???

Here's one I saved that gets the files in a folder, opens each, hides some
columns in each worksheet and closes (and saves) the file.

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wks As Worksheet
Dim TempWkbk As Workbook

'change to point at the folder to check
myPath = "C:\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set TempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

For Each wks In TempWkbk.Worksheets
wks.Range("K:L").EntireColumn.Hidden = True
Next wks

TempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

hi dave your versions great the only downside is that it goes from column to
column where as i need it to go row to row. i tried changing the offsets and
the definition to rows but all i ended up with was nofiles in my rows???

i managed to get a version before your reply and it works great.....until i
select a diffrent drive to c: then it stops working altogether please find
code below. your version however was able to search my d: which is brilliant

oh and the help to open the db i needed was cool too i tried so many
diffrent types of code (followhyperlink, openapp etc) but that one does the
job perfectly

thanks dave any further help is definatly appreciated

rivers
Sub Open_All_Files()
Dim sFil, sPath, sel As String
Dim i As Integer
sPath = d:\ 'location of files
sel =xls
Range("B:B").ClearContents
ChDir sPath
sFil = Dir("*." & sel) 'change or add formats
i = 3
Do While sFil <> "" 'will start LOOP until all files in folder sPath have
been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the
file
i = i + 1
Range("b" & i) = sFil 'put filename into cell range i
sFil = Dir
Loop ' End of LOOP
End Sub

 

[Rivers]

morning dave

in range a1 i enter the folder name (i have an open dialogue box to select
the folder and enter here) then once selected click on the macro to then in
rangeb2-b? the list of file names available in the folder requested.

 

[Rivers]

your version worked great dave for the rows one thankyou for so much help

 

[Rivers]

hi dave

ive again tried to modify your approach to my problem by increasing the
offset to suit my column needs (i need it to start at row b3 and continue
downwards) however now i have a new issue where im now geting three version
of the same lists in CDE columns.

Sub testme()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet2")
Set myRng = .Range("b3", .Cells(1, .Columns.Count).End(xlToLeft))

For Each myCell In myRng.Cells
myPath = Sheets("sheet1").Range("a2")

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.*")
On Error GoTo 0

If myFile = "" Then
myCell.Offset(1, 0).Value = "No files!"
Else
'get the list of files for that folder
'clean up existing names
Erase myNames
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
If fCtr > (.Rows.Count - 1) Then
'it won't fit, what should happen??
MsgBox "not enough rows!"
Else
myCell.Offset(1, 2).Resize(fCtr, 2).Value _
= Application.Transpose(myNames)
End If
End If
End If

 

[Dave Peterson]

If your folder names are in row 3, then this line needs to change:
Set myRng = .Range("b3", .Cells(1, .Columns.Count).End(xlToLeft))
to
Set myRng = .Range("b3", .Cells(3, .Columns.Count).End(xlToLeft))

(that first argument in the .cells() stuff is the row number.)

And this code doesn't clear out any existing data that could be hanging around.
Maybe that's the cause of the duplicates?

hi dave

ive again tried to modify your approach to my problem by increasing the
offset to suit my column needs (i need it to start at row b3 and continue
downwards) however now i have a new issue where im now geting three version
of the same lists in CDE columns.

Sub testme()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim myCell As Range
Dim myRng As Range

With Worksheets("sheet2")
Set myRng = .Range("b3", .Cells(1, .Columns.Count).End(xlToLeft))

For Each myCell In myRng.Cells
myPath = Sheets("sheet1").Range("a2")

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.*")
On Error GoTo 0

If myFile = "" Then
myCell.Offset(1, 0).Value = "No files!"
Else
'get the list of files for that folder
'clean up existing names
Erase myNames
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
If fCtr > (.Rows.Count - 1) Then
'it won't fit, what should happen??
MsgBox "not enough rows!"
Else
myCell.Offset(1, 2).Resize(fCtr, 2).Value _
= Application.Transpose(myNames)
End If
End If
End If

 

[Dave Peterson]

I'm confused.

Do you use a single folder name in A1 or do you put a bunch of folder names in
B3:X3?

morning dave

in range a1 i enter the folder name (i have an open dialogue box to select
the folder and enter here) then once selected click on the macro to then in
rangeb2-b? the list of file names available in the folder requested.

 

[Rivers]

hi dave

thank you for the help i canabilised your code and got this version below to
work perfectly i have posted it for others to use

the ranges used are:

folder to view=b1=c:\
file type to search for=b2=xls

heres the code it finds all the files in the folder and returns them to b3
and below
Sub testme2()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim sel As String
Dim i As Integer

Range("B3:B300").ClearContents
myPath = Sheets("sheet1").Range("b1")
sel = Sheets("sheet1").Range("b2")

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

ChDir myPath
i = 3
myFile = Dir(myPath & "*." & sel)

Do While myFile <> "" 'will start LOOP until all files in folder
Range("b" & i) = myFile 'put filename into cell range i
myFile = Dir
i = i + 1
Loop

If i = 3 Then
Range("b" & i) = "No Files Found.... "
End If
End Sub