PDA

View Full Version : Solved: Finding the file name



machunt
02-27-2012, 12:57 AM
Hi Forum,
I am using a code which I found on the net to read the file names from a folder.
Cross refer to a similar post on

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1042

My point is how do I get only the BaseName instead of the Name with extention.
and then generate tabs with those file name and hyperlink them.
and when ReRun Clear everything along with the generated sheets and rerun the code.
Regards,
Mac

mancubus
02-27-2012, 03:41 AM
hi.

try...

Cells(iRow, iCol).Value = Left(myfile.Name, InStrRev(myfile.Name, ".") - 1)

machunt
02-27-2012, 05:58 AM
Hi mancubus,
Thanks for the piece of code. it worked great.
Can you please suggest how do I generate sheets with those file name and hyperlink them.
Regards,
Mac

mancubus
02-27-2012, 08:37 AM
Sub ListFiles()

Dim wsBase As Worksheet, ws As Worksheet
Dim iRow As Long

Set wsBase = Worksheets("Sheet1")
iRow = 11
With wsBase
Call ListMyFiles(.Range("C7"), .Range("C8"))
For i = 11 To .Cells(.Rows.Count, "C").End(xlUp).Row
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = .Range("C" & i).Value
.Hyperlinks.Add Anchor:=.Range("C" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1"
Next
End With

End Sub

machunt
02-27-2012, 09:47 AM
Hi mancubus,
I replaced the existing ListFiles() code with your code. Unfortunately when I am running the code the pages are getting created with hyperlink, but the datas are also replicating in other cells.
Secondly,when I running the code again, ideally it should delete all the existing records along with all the sheets are redraw everything. But something is happening which I can't understand. Can you please guide me to solve the issue.
Best regards,
Mac

mancubus
02-27-2012, 02:51 PM
hi mac.

i'm not sure i'm understanding your requirement.

below code;
- deletes all sheets other than base sheet
- clears file list
- creates new file list
- adds new sheets and rename them as file names
- adds hyperlinks to those sheets in column G
- adds hyperlinks to base sheet in new sheets


Sub ListFiles()

Dim wsBase As Worksheet, ws As Worksheet
Dim iRow As Long, LR As Long

Set wsBase = Worksheets("Sheet1")

Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> wsBase.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True

iRow = 11
With wsBase
LR = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("B11:G" & LR).ClearContents
Call ListMyFiles(.Range("C7"), .Range("C8"))
For i = 11 To .Cells(.Rows.Count, "C").End(xlUp).Row
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = .Range("C" & i).Value
ws.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:="'" & wsBase.Name & "'!A1", TextToDisplay:="Back to Sheet1"
'above line inserts 'hyperlink to Sheet1' into cell A1 in all added sheets
.Hyperlinks.Add Anchor:=.Range("G" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
'above line inserts hyperlink to Column G, not column C that contains file names
Next
End With
wsBase.Activate

End Sub

machunt
02-27-2012, 07:12 PM
Hi mancubus,
Thanks for your code, unfortunately there is some communication gap in explaining the requirements. I will break down the requirement for easy view.
Step 1: I use this code to find the files in the folder
Dim iRow

Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
End Sub

Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myfile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myfile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = Left(myfile.Name, InStrRev(myfile.Name, ".") - 1)
'Cells(iRow, iCol).Value = myfile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myfile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myfile.DateLastModified
iCol = iCol + 1
Cells(iRow, iCol).Value = myfile.Type
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub


Step 2: I use a separate sub to generate worksheets and hyperlink them startring from C11

Step 3: I use another Sub to delete all the contents of the Sheet1 starting from B11 to F11 and also delete the associated hyperlinked sheets.

I am attaching a sheet which shows how I want the file to look like.
Best regards,
Mac

mancubus
02-28-2012, 01:07 AM
first you have to delete sheets. so change the step order.

Step 2 (Step 3 from your point))

Sub DeleteSheetsClearFileList()

Dim wsBase As Worksheet, ws As Worksheet
Dim LR As Long

Set wsBase = Worksheets("Sheet1")

Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> wsBase.Name Then ws.Delete
Next ws
Application.DisplayAlerts = True

With wsBase
LR = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("B11:F" & LR).ClearContents
End With

End Sub


Step 3 (Step 2 from your point))

Sub CreateSheetsHyperlink()

Dim wsBase As Worksheet, ws As Worksheet

Set wsBase = Worksheets("Sheet1")

With wsBase
For i = 11 To .Cells(.Rows.Count, "C").End(xlUp).Row
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = .Range("C" & i).Value
.Hyperlinks.Add Anchor:=.Range("C" & i), Address:="", SubAddress:="'" & ws.Name & "'!A1" ', TextToDisplay:=ws.Name
Next
End With

wsBase.Activate

End Sub

machunt
02-28-2012, 01:57 AM
Hi mancubus,
Aye aye Sir, That is absolutely perfect.
I am new to the forum, I don't know how to mark the post as solved. you can please mark it as solved.
Thanks forum.
Best Regards,
Mac
This post is 5* thanks to mancubus.

mancubus, I have another help from you,I don't know whether I should ask you here or in a new thread. As it deals with another file similar to this post, as I think i can use this code but don't know how to link them. I was hoping you can guide me. Thanks again.

mancubus
02-28-2012, 02:59 AM
you're wellcome.

click "thread tools" which is above first meaage.


you may post to this thread or, if you think req's are different, open a new thread and provide a link to this topic.

machunt
02-28-2012, 07:32 AM
Hi mancubus,
Thanks for the info,I have relpicated the code to other file, as such I just need few enhancement,i believe. So I am posting in the same thread. First I will explain you presently what I do. That will make the idea more clear.
I have various reports week wise in same format. (In excel - .xlsx)(In a single folder) which gets accumulated weekly.
I presently use access to collate these reports using simple SQL queries.
Eg.Select * from Report1
Union All
Select * from Report2
Union All
Select * from Report3
The problem is that I need to copy only the (sheet 9) of these report which basically contains my test results. The name of these sheet is "Final Report".
I was hoping if it is at all possible to do the same task using excel?
Like :
Step 1 : A seperate SUB that can simply copy (sheet 9) and paste it to its respected sheets
Eg.
1.In sheet (ABC), the original sheet 9 of that file gets copies.
2.In sheet (Copy (2) of Abc), the original sheet 9 of that file gets copies.
and continues.
Best regards,
Mac.

mancubus
03-02-2012, 09:40 AM
Step: 4


Sub CopyFromFilesToFileSheet()

Dim wbMain As Workbook, wb As Workbook
Dim wsBase As Worksheet, ws As Worksheet
Dim Calc As Long
Dim FileToOpen As String, wsToCopy As String

Set wbMain = ThisWorkbook
Set wsBase = wbMain.Worksheets("Sheet1")

With Application
.ScreenUpdating = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

With wsBase
For i = 11 To .Cells(.Rows.Count, "B").End(xlUp).Row
FileToOpen = .Range("B" & i).Value
wsToCopy = .Range("C" & i).Value
Set wb = Workbooks.Open(FileToOpen)
Set ws = wb.Worksheets("Final Report")
ws.Cells.Copy
wbMain.Worksheets(wsToCopy).Activate
With ActiveSheet
.Paste
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Range("A1").Select
End With
wb.Close False
Next
End With

wsBase.Activate

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = Calc
End With

End Sub

machunt
03-02-2012, 10:33 AM
Hi mancubus,
That's amazing and it's perfect.
This really solves my problem to a great extent. I can now now only use excel to recall the data instead of opening access. It was a mess using access.
Thanks a ton. I really appreciate the help i received for the past few days. Every bit was worth it. I am really proud to be a member in this forum.
Unfortunately I can't mark it solved. As soon as I clicked the thread tools it it taking be to the bottom of the page.
Moderators can mark it as solved.
This time 10/10 mancubus.
Best regards,
Mac

mancubus
03-02-2012, 11:09 AM
wellcome max.
glad it helped.

i think internet explorer will make it.