ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Finding files on external drives... (https://www.excelbanter.com/excel-programming/363048-finding-files-external-drives.html)

trumb1mj

Finding files on external drives...
 

I currently I am working on a dashboard type project for work. I have
been able to pull .xls files from other folders through different
paths, the problem is that I need to be able to get files from a
password protected directory on a remote computer. Is this possible?
Any help would be great. Here is my current code:

Sub Update500()

'Stops screen flashes

Application.ScreenUpdating = False

'Selects and clears range

Range("A1").Select
Range("A3:E5000").Select
Selection.ClearContents

Dim wbResult As Workbook
Dim wbSource As Workbook
Dim MyFolder As String
Dim CopyRng1 As Range
Dim CopyRng2 As Range
Dim CopyRng3 As Range
Dim Dest As Range
Dim i As Integer

'Selects folder that will be searched

MyFolder = "\\wk500\c\QA\TestCases"
Set wbResult = ThisWorkbook

'Selects destination worksheet

Set Dest = wbResult.Sheets("Dashboard").[a2]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
..NewSearch
..LookIn = MyFolder
..FileType = msoFileTypeExcelWorkbooks
If .Execute 0 Then



For i = 1 To .FoundFiles.Count


'Selects test case file from folder

Set wbSource = Workbooks.Open(Filename:=.FoundFiles(i),
UpdateLinks:=0)
Application.StatusBar = "It's Updating " & wbSource.Name & " Pl.
Wait...."

'Unhides input cells

Columns("S:X").Select
Selection.EntireColumn.Hidden = False

'Adds filename to intput cells
Range("T3") = ActiveWorkbook.Name

'Selects and copies input cells

Range("T3:X3").Select
Selection.Copy

'Says that file has been saved

ActiveWorkbook.Saved = True
Application.DisplayAlerts = False

'Closes test case
ActiveWindow.Close


'Activates dashboard and selects cells

Windows("dashboard.xls").Activate
Range("A1:E1").Select

'Selects last filled cells and moves one row below

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

'Pastes input cells

ActiveSheet.paste

'Moves to next test case file

Next i
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.StatusBar = False

'Notifies user that update is complete

MsgBox "All tests have been updated into the Dashboard!", , "Update
Complete"
End Sub


--
trumb1mj
------------------------------------------------------------------------
trumb1mj's Profile: http://www.excelforum.com/member.php...o&userid=34847
View this thread: http://www.excelforum.com/showthread...hreadid=547578


trumb1mj[_2_]

Finding files on external drives...
 

Looks like I have stumped the Excel master's on this site. hmmmmm.


--
trumb1mj
------------------------------------------------------------------------
trumb1mj's Profile: http://www.excelforum.com/member.php...o&userid=34847
View this thread: http://www.excelforum.com/showthread...hreadid=547578


trumb1mj[_3_]

Finding files on external drives...
 

man



oh




man.....


--
trumb1mj
------------------------------------------------------------------------
trumb1mj's Profile: http://www.excelforum.com/member.php...o&userid=34847
View this thread: http://www.excelforum.com/showthread...hreadid=547578



All times are GMT +1. The time now is 05:44 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com