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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.