-
Coding in suport of these excelfox Threads and posts:
http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11089&viewfull=1#post11089
https://www.excelforum.com/excel-pro...-the-file.html
Code:
Sub DirOrder() ' http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11092&viewfull=1#post11092
Dim strWB As String
Rem 1 get the full string, strWB, for a Folder to use in the Dir(Fullpath&FileName, __ ) ( strWB=Fullpath&FileName - FileName )
'1a) use the asking pop up thing, File dialogue folder picker
' With Application.FileDialog(msoFileDialogFolderPicker)
' .Title = "Folder Select"
' .AllowMultiSelect = False
' If .Show <> -1 Then
' Exit Sub
' Else
' End If
' Let strWB = .SelectedItems(1) ' & "\"
' End With
'
'1b) Using a test Folder, named Folder in the same Folder as the workbook in which this code is
Let strWB = ThisWorkbook.Path & "\Folder"
'1c) Hard code instead
'Let strWB = "F:\Excel0202015Jan2016\ExcelForum\wbSheetMakerClsdWbADOMsQueery\Kill Stuff\Folder"
Debug.Print "Folder used is" & vbCrLf & strWB & vbCrLf & "" & Right(strWB, (Len(strWB) - InStrRev(strWB, "\", -1, vbTextCompare)))
Debug.Print
Let strWB = strWB & "\"
Rem 2 add last file bit for use in the Dir(Fullpath&FileName, __ ) , but include wild cards... http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11089&viewfull=1#post11089 : _(i) You can use wild cards in the full path and file name string that you give it, so it will look for a file matching your given string. ( So typically you might give a string like “C:\myFolder\*.xl*”, which would look for any excel file: In this bit *.xl* , the first * allows for any file name, and the second * will allow for extensions such as .xls , .xlsm, .xlsx, .. etc… ) _(ii) After you use like Dir(Fullpath&FileName, __ ) once, then any use after of just _ Dir __ without any arguments, will give the next file it finds based on the string you gave in the first use with arguments
'2a) Excel files
Let strWB = strWB & "*.xls*"
Dim File As String: Let File = Dir(strWB)
Debug.Print "First got by Dir(" & strWB & ")" & vbCrLf & "is " & File
Debug.Print
Do ' '_- I want to keep going in a Loop while I still get a file name returned by Dir
Dim Cnt As Long: Let Cnt = Cnt + 1
Let File = Dir: Debug.Print "Use " & Cnt & " in loop of unargumented Dir gives """ & File & """"
Loop While File <> "" '_- I want to keep going in a Loop while I still get a file name returned by Dir
Debug.Print
Debug.Print
End Sub
Here last routine in form to allow user selection of folder to search for files
Code:
Sub DirOrder() ' http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11093&viewfull=1#post11093
Dim strWB As String
Rem 1 get the full string, strWB, for a Folder to use in the Dir(Fullpath&FileName, __ ) ( strWB=Fullpath&FileName - FileName )
'1a) use the asking pop up thing, File dialogue folder picker
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Folder Select"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
Else
End If
Let strWB = .SelectedItems(1) ' & "\"
End With
'1b) Using a test Folder, named Folder in the same Folder as the workbook in which this code is
'Let strWB = ThisWorkbook.Path & "\Folder"
'1c) Hard code instead
'Let strWB = "F:\Excel0202015Jan2016\ExcelForum\wbSheetMakerClsdWbADOMsQueery\Kill Stuff\Folder"
Debug.Print "Folder used is" & vbCrLf & strWB & vbCrLf & "" & Right(strWB, (Len(strWB) - InStrRev(strWB, "\", -1, vbTextCompare)))
Debug.Print
Let strWB = strWB & "\"
Rem 2 add last file bit for use in the Dir(Fullpath&FileName, __ ) , but include wild cards... http://www.excelfox.com/forum/showthread.php/2056-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11089&viewfull=1#post11089 : _(i) You can use wild cards in the full path and file name string that you give it, so it will look for a file matching your given string. ( So typically you might give a string like “C:\myFolder\*.xl*”, which would look for any excel file: In this bit *.xl* , the first * allows for any file name, and the second * will allow for extensions such as .xls , .xlsm, .xlsx, .. etc… ) _(ii) After you use like Dir(Fullpath&FileName, __ ) once, then any use after of just _ Dir __ without any arguments, will give the next file it finds based on the string you gave in the first use with arguments
'2a) Excel files
Let strWB = strWB & "*"
Dim File As String: Let File = Dir(strWB)
Debug.Print "First got by Dir(" & strWB & ")" & vbCrLf & "is " & File
Debug.Print
Do ' '_- I want to keep going in a Loop while I still get a file name returned by Dir
Dim Cnt As Long: Let Cnt = Cnt + 1
Let File = Dir: Debug.Print "Use " & Cnt & " in loop of unargumented Dir gives """ & File & """"
Loop While File <> "" '_- I want to keep going in a Loop while I still get a file name returned by Dir
Debug.Print
Debug.Print
End Sub
-
Initial coding for solution to this Thread
http://www.excelfox.com/forum/showth...ll=1#post11124
File : "Data Sheet.xls" : https://app.box.com/s/wvusyk3ish5z3mxdwvw3sw9n683m58rq
Code:
Option Explicit '
Sub HaiderAdSlots1() ' http://www.excelfox.com/forum/showthread.php/2330-Fill-Column-Based-on-Actual-Time?p=11124&viewfull=1#post11124
Rem 1 Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Sheet1"): Set Ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row & "").Row: Let Lr2 = Ws1.Range("A" & Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row & "").Row
'1b) data arrays, original data
Dim arrInSht2() As Variant, arrOutSht1() As Variant
Let arrInSht2() = Ws2.Range("A1:G" & Lr2 & "").Value2: Let arrOutSht1() = Ws1.Range("A1:C" & Lr1 & "").Value2
'1b)(ii) extra "column" for outout
ReDim Preserve arrOutSht1(1 To Lr1, 1 To 4) ' we may add a last dimension, but must keep the others the same as they were
Rem 2 arrays to identify rows ... " Channel Name & Date & Time "
Dim arrInId() As String
ReDim arrInId(1 To Lr2)
Dim cnt As Long
For cnt = 2 To Lr2
Let arrInId(cnt) = arrInSht2(cnt, 1) & " | " & arrInSht2(cnt, 2) & " | " & arrInSht2(cnt, 3)
Next cnt
Dim arrOutId() As String
ReDim arrOutId(1 To Lr1)
For cnt = 2 To Lr1
Let arrOutId(cnt) = arrOutSht1(cnt, 2) & " | " & arrOutSht1(cnt, 1) & " | " & arrOutSht1(cnt, 3)
Next cnt
Rem 3 match up rows in data sheets
For cnt = 2 To Lr1
Dim MtchRes As Variant
Let MtchRes = Application.Match(arrOutId(cnt), arrInId(), 1) ' return the position along of a match ( looking for arrOutId(cnt) , in arrInId() , 1 indicates approximate match )
If Not IsError(MtchRes) Then
'3b)
Let arrOutSht1(cnt, 4) = arrInSht2(MtchRes, 3)
Else
End If
Next cnt
Rem 4
Let ThisWorkbook.Worksheets("OutputTest").Range("A1").Resize(UBound(arrOutSht1(), 1), 4).Value = arrOutSht1()
End Sub
-
1 Attachment(s)
-
1 Attachment(s)
In support of this thread
http://www.excelfox.com/forum/showth...ll=1#post11134
Sheet2v3.JPG : Attachment 2245
_____ Workbook: Data Sheet v3.xls ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
| 1 |
Channel |
Date |
AdStart |
MidBreak |
Break_Start |
Break_End |
Hour |
| 2 |
A NEWS |
15.11.2017 |
20:19:12 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 3 |
A NEWS |
15.11.2017 |
20:19:32 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 4 |
A NEWS |
15.11.2017 |
20:19:49 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 5 |
A NEWS |
15.11.2017 |
20:20:01 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 6 |
A NEWS |
15.11.2017 |
20:20:47 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 7 |
A NEWS |
15.11.2017 |
20:21:10 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 8 |
A NEWS |
15.11.2017 |
20:21:20 |
Mid Break-1 |
20:19:08 |
20:24:07 |
20 |
| 42 |
A NEWS |
15.11.2017 |
20:58:16 |
Casual |
20:57:14 |
20:59:57 |
20 |
| 43 |
A NEWS |
15.11.2017 |
20:58:33 |
Casual |
20:57:14 |
20:59:57 |
20 |
| 44 |
A NEWS |
15.11.2017 |
20:58:42 |
Casual |
20:57:14 |
20:59:57 |
20 |
| 45 |
A NEWS |
15.11.2017 |
20:59:01 |
Casual |
20:57:14 |
20:59:57 |
20 |
| 46 |
A NEWS |
15.11.2017 |
22:26:58 |
Mid Break-1 |
22:26:54 |
22:33:55 |
22 |
_......... continued in next posts due to post size limitations ( 10,000 characters incl. BB code )
-
_____ Workbook: Data Sheet v3.xls ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
| 45 |
A NEWS |
15.11.2017 |
20:59:01 |
Casual |
20:57:14 |
20:59:57 |
20 |
| 46 |
A NEWS |
15.11.2017 |
22:26:58 |
Mid Break-1 |
22:26:54 |
22:33:55 |
22 |
| 47 |
A NEWS |
15.11.2017 |
22:27:18 |
Mid Break-1 |
22:26:54 |
22:33:55 |
22 |
| 48 |
A NEWS |
15.11.2017 |
22:27:36 |
Mid Break-1 |
22:26:54 |
22:33:55 |
22 |
| 49 |
A NEWS |
15.11.2017 |
22:28:06 |
Mid Break-1 |
22:26:54 |
22:33:55 |
22 |
| 78 |
A NEWS |
15.11.2017 |
22:53:03 |
Mid Break-2 |
22:47:02 |
22:54:02 |
22 |
| 79 |
A NEWS |
15.11.2017 |
22:53:18 |
Mid Break-2 |
22:47:02 |
22:54:02 |
22 |
| 80 |
A NEWS |
15.11.2017 |
22:53:42 |
Mid Break-2 |
22:47:02 |
22:54:02 |
22 |
| 81 |
A NEWS |
15.11.2017 |
22:57:15 |
Casual |
22:57:11 |
23:00:05 |
22 |
| 87 |
A NEWS |
15.11.2017 |
22:58:48 |
Casual |
22:57:11 |
23:00:05 |
22 |
| 88 |
A NEWS |
15.11.2017 |
22:59:08 |
Casual |
22:57:11 |
23:00:05 |
22 |
| 89 |
A NEWS |
18.11.2017 |
23:01:21 |
Mid Break-1 |
23:01:17 |
23:03:21 |
23 |
| 90 |
A NEWS |
18.11.2017 |
23:01:37 |
Mid Break-1 |
23:01:17 |
23:03:21 |
23 |
| 91 |
A NEWS |
18.11.2017 |
23:01:57 |
Mid Break-1 |
23:01:17 |
23:03:21 |
23 |
| 140 |
A NEWS |
18.11.2017 |
23:43:10 |
Mid Break-3 |
23:33:53 |
23:44:55 |
23 |
| 141 |
A NEWS |
18.11.2017 |
23:43:40 |
Mid Break-3 |
23:33:53 |
23:44:55 |
23 |
| 142 |
A NEWS |
18.11.2017 |
23:44:39 |
Mid Break-3 |
23:33:53 |
23:44:55 |
23 |
| 143 |
A NEWS |
18.11.2017 |
23:57:21 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 144 |
A NEWS |
18.11.2017 |
23:57:31 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 145 |
A NEWS |
18.11.2017 |
23:57:39 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 146 |
A NEWS |
18.11.2017 |
23:57:57 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 150 |
A NEWS |
18.11.2017 |
23:58:46 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 151 |
A NEWS |
18.11.2017 |
23:59:06 |
Casual |
23:57:21 |
23:59:58 |
23 |
| 152 |
B NEWS |
16.11.2017 |
20:01:24 |
Mid Break-2 |
20:01:24 |
20:01:50 |
20 |
| 153 |
B NEWS |
16.11.2017 |
20:15:08 |
Mid Break-1 |
20:15:08 |
20:20:20 |
20 |
| 196 |
B NEWS |
16.11.2017 |
20:42:04 |
Mid Break-2 |
20:31:41 |
20:43:24 |
20 |
| 197 |
B NEWS |
16.11.2017 |
20:42:14 |
Mid Break-2 |
20:31:41 |
20:43:24 |
20 |
| 198 |
B NEWS |
16.11.2017 |
20:42:29 |
Mid Break-2 |
20:31:41 |
20:43:24 |
20 |
| 199 |
B NEWS |
16.11.2017 |
20:42:49 |
Mid Break-2 |
20:31:41 |
20:43:24 |
20 |
| 200 |
B NEWS |
16.11.2017 |
20:53:38 |
Casual |
20:53:38 |
21:00:02 |
20 |
-
Notes in support of these excelfox Threads and posts:
http://www.excelfox.com/forum/showth...ista-and-Excel
http://www.excelfox.com/forum/showth...r-CMS-Software
https://www.ebay.de/itm/323782698418?ul_noapp=true , _ https://imgur.com/Xq2hih2
Tests Friday, 7th June 2019.
OK I make Today two tries on one computer : Computer Acer Aspire 4810TZG Vista Operating System
_1 Try one: My computer is connected to the internet using the same router as that to which the Sannce 1080N Receiver is successfully connected . (German Telekom Speedport W504V Router LAN RJ45 Internet connection)
Delete a desktop "Deinstaller CMS" icon
