Video Capture with Windows 10

June 14, 2016, 12:18 pm

≫ Next: [RESOLVED] what vb6 component is this ?

≪ Previous: Is there a place to download OCX files?

$

0

0

Hey guys. I have an old OCX called EzVidCap by Ray Mercer. It grabs a snapshot from a camera. Works great on every Windows version right up to Windows 8.1. For some reason it doesn't run on Windows 10. Can't find the camera list.

I found a thread in the CodeBank but the examples don't run under Windows 10 either.

http://www.vbforums.com/showthread.p...m-Minimal-Code

So here's the question... is there a nice simple OCX or method of grabbing an image from a camera in Windows 10?

---

[RESOLVED] what vb6 component is this ?

June 14, 2016, 12:40 am

≫ Next: [RESOLVED] save formatted text character to database

≪ Previous: Video Capture with Windows 10

$

0

0

what vb6 component is this ?

Attached Images

 

[RESOLVED] save formatted text character to database

June 14, 2016, 5:14 pm

≫ Next: Calling cdecl DLL with vbRichClient5

≪ Previous: [RESOLVED] what vb6 component is this ?

$

0

0

This is in line with my thread "what vb6 component is this ?" but I am not using yet the RTBCompose example given by Dilletante. Thanks again for that example Dilletante.


So I have created the toolbox to modify the text character's boldness, italic, alignment, font size, font type, etc.

So I make the text character in the RichTextBox to Bold, with font size 20, then I save the richtextbox content to database but when I retrieve it, the formatted bold and font size 20 of the content is not restored upon presentation back to the richtextbox. What to do ?

Calling cdecl DLL with vbRichClient5

June 14, 2016, 5:23 pm

≫ Next: How to remove the WebBrowser's context menu

≪ Previous: [RESOLVED] save formatted text character to database

$

0

0

Hello.
I have a "test.dll" and it declares functions in cdecl. Knowing that vbRichClient5 can call these functions, I tried to call some functions and it succeeded.
However, there's a function I can't do so. Here's the code in a header:

Code:

---

__cdecl __declspec(dllimport) int16_t fileput(void *handle, const char *localpath, const char *remotepath);

---

And in VB6, I wrote like this:

Code:

---

Public Function FilePut(ByVal Handle as Long, ByVal LocalPath as String, ByVal RemotePath as String) as Integer
'libHandle = LoadLibrary("test.dll")
'Set Con as New cConstructor
Dim pFunc as Long
pFunc = GetProcAddress(libHandle, "fileput")
Debug.Assert pFunc

Dim ret as Integer
Dim tmpLocalPath as String * 255, tmpRemotePath as String * 255
tmpLocalPath = StrConv(LocalPath, vbFromUnicode)
tmpRemotePath = StrConv(RemotePath, vbFromUnicode)
ret = Con.cdeclCall(retInteger, pFunc, Handle, tmpLocalPath, tmpRemotePath)
Debug.Assert ret >= 0

FilePut = ret
End Function

---

It returns "Invalid argument". But I tried in another language with the same arguments and it succeeded. Can anyone figure out what goes wrong?

Thanks.

How to remove the WebBrowser's context menu

June 14, 2016, 9:36 pm

≫ Next: Drawing in Containers without Line Method

≪ Previous: Calling cdecl DLL with vbRichClient5

$

0

0

Hello I am writing this thread to find out how to remove the Internet Explorer's WebBrowser Control click context menu by stopping all mouse clicks such as double click, click, mouse move, mouse up, mouse down and other such things. However to keep mouse navigation and link clickable workable as per the normal function. I am looking to write my own web browser and to add in my own context menu. I have been able to make a context menu using my own type of menu items, ones that don't have back, forward and send as email, etc. Those things I find that they present a problem of over cluttering the program, by nonsense and by that type of nature of things. This isn't a virus or malware type of program or application. I could be able to post the project as an attachment to the thread, in a future post if need be by anyone that requests it by me. also the reason that it's an ocx file, I am making it workable in my windows operating system, which I am calling it Windows SX, which I am going to give half of the rights to the Microsoft Corporation and we can do a deal with them. because I am working a Microsoft Partner type of deal, that I haven't as yet got my license to be a Partner of them as per yet. I am waiting for them to see what I can do with source code.

!! Thanks in advance !!

Drawing in Containers without Line Method

June 14, 2016, 9:36 pm

≫ Next: [RESOLVED] support directory created with package wizard

≪ Previous: How to remove the WebBrowser's context menu

$

0

0

Quote:

---

Originally Posted by Frans C

Code:

---

Private Sub Command1_Click()
    Call DrawBorder(Label1, vbRed)
End Sub

Private Sub DrawBorder(lbl As Label, Color As OLE_COLOR)
    With lbl
        Me.Line (.Left, .Top)-(.Left + .Width - Screen.TwipsPerPixelX, .Top + .Height - Screen.TwipsPerPixelY), Color, B
    End With
End Sub

---

---

If a label is plaleced in a container like a Frame or a Tab control which dont have Line method, how can draw a line in this case?

[RESOLVED] support directory created with package wizard

June 14, 2016, 10:09 pm

≫ Next: list facebook friends

≪ Previous: Drawing in Containers without Line Method

$

0

0

I always wondered, just what is the 'support' directory that is created when using Package & Deployment wizard suppose to be for? Does anyone actually include it in the Zip file?

list facebook friends

June 14, 2016, 10:21 pm

≫ Next: Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

≪ Previous: [RESOLVED] support directory created with package wizard

$

0

0

hi all, i am trying to create a list of my facebook friends.

i navigate to "my friends" page then hit a command button containing

Code:

---

Private Sub ListLinks1()
 Dim q1, q2
Dim Inner As String
Inner = WebBrowser1.document.documentElement.innerHTML
q1 = 1
again:
q1 = InStr(q1, Inner, "facebook.com/", vbTextCompare)
If q1 > 1 Then
  q2 = InStr(q1, Inner, "&")
  If q2 > 0 Then
    Me.List1.AddItem Mid(Inner, q1, q2 - q1)                  ' Finds Links containing Bla and list them in list 1
q1 = q2

    GoTo again
  End If
End If


End Sub

---

this list my friends pages, but also a lot of other links that are not needed. i could try adding delimiters but i would need alot of them. is there a better way of creating a list of my facebook friends page links. the reason for doing this is i want to be able to scan my friends time lines for game offers.

---

Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

June 15, 2016, 8:05 am

≫ Next: [RESOLVED] Trying to insert Events From Access To OutLook Only 1 appointment is added why?

≪ Previous: list facebook friends

$

0

0

I am updating an OCX somebody else wrote, all is well, runs from code great, compiles with no errors. When I try to use it, I get the dreaded "ClassFactory cannot supply requested class" error message. I've done some googling, and it seems everyone is having a problem due to unregistered controls and such. This does use MsComm, but it's registered and other controls are also using MsComm without issue.

The interesting part is that I checked my code into source safe and someone else pulled the code and compiled it, with no edits at all, and their compiled OCX works fine. This is the first time I've compiled an OCX and I'm wondering if there is something wrong with my VB6 install. We are both running the latest service pack. I tried compiling some other OCXs from VSS and they all do the same thing. The error shows up when I compile them, works fine when the other user compiles.

Any ideas what could be causing this?

[RESOLVED] Trying to insert Events From Access To OutLook Only 1 appointment is added why?

June 15, 2016, 12:44 pm

≫ Next: First letter capitalized

≪ Previous: Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

$

0

0

never mind found the solution :D

First letter capitalized

June 15, 2016, 2:52 pm

≫ Next: [RESOLVED] Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

≪ Previous: [RESOLVED] Trying to insert Events From Access To OutLook Only 1 appointment is added why?

$

0

0

Hello VBForums
Hello everyone
Please gentelmans
If you can help me solve this problem ..
In my form1 i have Frame 1 with Text1 and Frame2 with Text2
I also have a code to put the first letters of words of a sentence in uppercase
But this code in Text1 works very very well and in Text2 not working properly
My code :

Code:

---

Dim MADA  As Boolean
Private Sub Command1_Click()
Form1.Frame1.Visible = True
Form1.Frame2.Visible = False
End Sub
Private Sub Command2_Click()
Form1.Frame2.Visible = True
Form1.Frame1.Visible = False
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
 
If MADA = False Then
KeyAscii = KeyAscii - 32
MADA = True
End If
If KeyAscii = 32 Then
MADA = False
End If
Text1.SetFocus

End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
 
If MADA = False Then
KeyAscii = KeyAscii - 32
MADA = True
End If
If KeyAscii = 32 Then
MADA = False
End If
Text2.SetFocus

End Sub

---

Thank you in advance for help
Cordially
MADA BLACK

Attached Images

  

[RESOLVED] Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

June 15, 2016, 8:05 am

≫ Next: DirectShow Problem

≪ Previous: First letter capitalized

$

0

0

I am updating an OCX somebody else wrote, all is well, runs from code great, compiles with no errors. When I try to use it, I get the dreaded "ClassFactory cannot supply requested class" error message. I've done some googling, and it seems everyone is having a problem due to unregistered controls and such. This does use MsComm, but it's registered and other controls are also using MsComm without issue.

The interesting part is that I checked my code into source safe and someone else pulled the code and compiled it, with no edits at all, and their compiled OCX works fine. This is the first time I've compiled an OCX and I'm wondering if there is something wrong with my VB6 install. We are both running the latest service pack. I tried compiling some other OCXs from VSS and they all do the same thing. The error shows up when I compile them, works fine when the other user compiles.

Any ideas what could be causing this?

DirectShow Problem

June 15, 2016, 4:29 pm

≫ Next: Compare Two Textboxs

≪ Previous: [RESOLVED] Loading my OCX compiled by me gives "ClassFactory cannot supply requested class"error

$

0

0

Hi all, I've been using DirectShow (in VB6 SP6) for sometime now, but I just can't seem to get a resolution higher than 640x480 on a 720p camera, am I missing something?

Cheers!

Compare Two Textboxs

June 16, 2016, 1:05 am

≫ Next: [RESOLVED] trying to delete all appointments in outlook deletes only 1 item why?

≪ Previous: DirectShow Problem

$

0

0

HI All

Could someone please point me in the right direction, I have two textboxes that I want compare, if they match the code continues, if they don't then brings up a message but these textbox will change its contents as they getting data via rs232.

Regards

Steve

[RESOLVED] trying to delete all appointments in outlook deletes only 1 item why?

June 16, 2016, 1:28 am

≫ Next: [RESOLVED] how do i get the total duration from 2 subitems

≪ Previous: Compare Two Textboxs

$

0

0

hey,
somehow the code deletes only a single item
and i have a loop in there strange
what i am missing?
this is my code

Code:

---

    Dim oOutlook As New Outlook.Application
    Dim oNameSpace As Namespace
    Dim Appointment As Object
    Dim OcalItems As Items
    Dim AppointmentDate As String
   
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set OcalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
    AppointmentDate = "06.02.2002 10:30:00"
    Set Appointment = OcalItems.GetFirst
   
    Do While Not (Appointment Is Nothing)
        If Appointment.Start < AppointmentDate Then
            Appointment.Delete
        End If
        Set Appointment = OcalItems.GetNext
    Loop
    Set Appointment = Nothing
    Set OcalItems = Nothing
    Set oNameSpace = Nothing
    Set oOutlook = Nothing

---

tnx for any help
salsa :)

---

[RESOLVED] how do i get the total duration from 2 subitems

June 16, 2016, 4:11 am

≫ Next: How to optimize the following code

≪ Previous: [RESOLVED] trying to delete all appointments in outlook deletes only 1 item why?

$

0

0

hey,
i am trying how to get the total duration from 2 subitems
E.X

this of course are date/time values
LsvwTreats.ListItems(X).SubItems(1) = 10:00
LsvwTreats.ListItems(X).SubItems(2) = 10:30
so the total duration is 30 minutes

LsvwTreats.ListItems(X).SubItems(1) = 09:00
LsvwTreats.ListItems(X).SubItems(2) = 11:00
so the total duration is 120 minutes

and so on...

Code:

---

StartDate = Format(m_pEditingEvent.StartTime, "dd/mm/yyyy") & " " & LsvwTreats.ListItems(X).SubItems(1)
EndDate = Format(m_pEditingEvent.StartTime, "dd/mm/yyyy") & " " & LsvwTreats.ListItems(X).SubItems(2)

---

tnx for any help
salsa :)

How to optimize the following code

June 16, 2016, 7:10 am

≫ Next: Using VB on Mac to find txt files in folder, copy tab into single document, and loop

≪ Previous: [RESOLVED] how do i get the total duration from 2 subitems

$

0

0

Hi, I have a code which is redundant. Sp please help me in optimizing the code.

Basically I am feting a fetching a version number from registry. It can be in any of one of 6 path. So I am iterating like below code. I feel there can be something better than this. Please help me to optimize the below code.

Private Function as Integer()

'Some Code
versionnum = GetRegValue (hKey,path1,"Version","")

If versionnum = "" Then
versionnum = GetRegValue (hKey,path2,"Version","")
EndIf

If versionnum = "" Then
versionnum = GetRegValue (hKey,path3,"Version","")
EndIf

If versionnum = "" Then
versionnum = GetRegValue (hKey,path4,"Version","")
EndIf

If versionnum = "" Then
versionnum = GetRegValue (hKey,path5,"Version","")
EndIf

If versionnum = "" Then
versionnum = GetRegValue (hKey,path6,"Version","")
EndIf

returnval = CompareVersion(Expected,versionnum)
'Some Code

End Function

Using VB on Mac to find txt files in folder, copy tab into single document, and loop

June 16, 2016, 7:19 am

≫ Next: how can i extract files from resource with progressbar ?

≪ Previous: How to optimize the following code

$

0

0

Hello All :wave:, As a relative novice, I have been trying different online scripts and strategies and using online forums to accomplish this task for a couple days now, so I am officially giving up and making a post. The problem, I believe, is that I am using a Mac (OS Yosemite 10.10.5, Excel for Mac 14.6.4). It will not allow me to do simple things, such as:

• Wildcards (*.txt)
• Anything like this, where defining the variable as a string is combined with something else: "For Each foundFile As String In My.Computer.FileSystem.GetFiles"
• The Import command
• Certain types of definitions, such as Dim X As List(Of String)
• Others

I am currently trying to work with code that I obtained from Ron de Bruin that gets around the wildcard issue, although it is originally meant to work out of an Excel worksheet, so I may have copied and pasted inappropriately. I changed it to try to get it to do what I want (find all text files in designated folder, open as tab-delimited, and copy the first tab from each folder and move to a single document).

I get the MsgBox "Sorry no files that match your criteria," the screen flickers, and that's the end of it.

Here is the Frankenstein code I have made:

Code:

---

Option Explicit

'Important: this Dim line must be at the top of your module
Dim MyFiles As String
Dim folderPath As String

Sub FromGetFiles()
Dim MySplit As Variant
Dim FileInMyFiles As Long

MyFiles = ""

'folderPath = ("/Users/myusername/Google\ Drive/3.\ Research\ and\ Writing\ NEW/1.\ Dissertation/1.\ Data\ and\ Analysis/3.\ Superlab\ Data\ COMPLETE/")

folderPath = ("Macintosh HD:Users:myusername:Google Drive:3. Research and Writing NEW:1. Dissertation:1. Data and Analysis:3. Superlab Data COMPLETE:")

Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFilterOption:=6, FileNameFilterStr:="SearchString")

If MyFiles <> "" Then
 'Split MyFiles and loop through all the files
        MySplit = Split(MyFiles, Chr(13))
        For FileInMyFiles = LBound(MySplit) To UBound(MySplit)
            On Error Resume Next

''''THIS IS THE PART I ADDED''''''
                        Workbooks.OpenText fileName:=folderPath & FileInMyFiles, Origin:=xlMacintosh, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
                            False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array _
                            (1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8 _
                            , 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _
                            Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1))
                        Sheets(1).Select
                        Application.CutCopyMode = False
                        Sheets(1).Copy After:=Workbooks("D. Stroop Analysis Court.xlsm").Sheets(1)

''''END OF THE PART I ADDED''''''

        On Error GoTo 0
        Next FileInMyFiles
Else
      MsgBox "Sorry no files that match your criteria"
        With Application
            .ScreenUpdating = True
        End With
    End If
End Sub

Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)

    Dim ScriptToRun As String
    Dim folderPath As String
    Dim FileNameFilter As String
    Dim Extensions As String

    On Error Resume Next

    'folderPath = MacScript("choose folder as string")

    'folderPath = ("/Users/myusername/Google\ Drive/3.\ Research\ and\ Writing\ NEW/1.\ Dissertation/1.\ Data\ and\ Analysis/3.\ Superlab\ Data\ COMPLETE")

    folderPath = ("Macintosh HD
:Users:myusername:Google Drive:3. Research and Writing NEW:1. Dissertation:1. Data and Analysis:3. Superlab Data COMPLETE:")

    If folderPath = "" Then Exit Function

    On Error GoTo 0

    Select Case ExtChoice
    Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)"  'xls, xlsx , xlsm, xlsb
    Case 1: Extensions = "xls"    'Only  xls
    Case 2: Extensions = "xlsx"    'Only xlsx
    Case 3: Extensions = "xlsm"    'Only xlsm
    Case 4: Extensions = "xlsb"    'Only xlsb
    Case 5: Extensions = "csv"    'Only csv
    Case 6: Extensions = "txt"    'Only txt
    Case 7: Extensions = ".*"    'All files with extension, use *.* for everything
    Case 8: Extensions = "(xlsx|xlsm|xlsb)"  'xlsx, xlsm , xlsb
    Case 9: Extensions = "(csv|txt)"  'csv and txt files
        'You can add more filter options if you want,
    End Select

    Select Case FileFilterOption
    Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' "  'No Filter
    Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' "    'Begins with
    Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' "    ' Ends With
    Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' "  'Contains
    End Select

        'folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
                          Chr(34) & " to return quoted form of it's POSIX Path")
    folderPath = Replace(folderPath, "'\''", "'\\''")

    If Val(Application.Version) < 15 Then
        ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """)" & Chr(13)
        ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
        ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
        ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
        ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
        ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
        ScriptToRun = ScriptToRun & "foundPaths"
    Else
        ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """ "
    End If
    On Error Resume Next
    MyFiles = MacScript(ScriptToRun)
    On Error GoTo 0
End Function

---

For reference, here is the original code:

Code:

---

Option Explicit

'Important: this Dim line must be at the top of your module
Dim MyFiles As String


Sub TestMacroForThisfileWithCellReferences()
    Dim MySplit As Variant
    Dim FileInMyFiles As Long
    Dim Fstr As String
    Dim LastSep As String

    'Note: I use cell references in this macro to make it easy to test the code
    'Normally you will use it like this :
    'Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFilterOption:=0, FileNameFilterStr:="SearchString")

    'Clear MyFiles to be sure that it not return old info if no files are found
    MyFiles = ""

    'Fill the MyFiles string with the files if they match your criteria
    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=Range("F9").Value, ExtChoice:=Range("G9").Value, FileFilterOption:=Range("H9").Value, FileNameFilterStr:=Range("I9").Text)
    'Level                    : 1= Only the files in the folder, 2 to ? levels of subfolders
    'ExtChoice            :  0=(xls|xlsx|xlsm|xlsb), 1=xls , 2=xlsx, 3=xlsm, 4=xlsb, 5=csv, 6=txt, 7=all files, 8=(xlsx|xlsm|xlsb), 9=(csv|txt)
    'FileFilterOption    :  0=No Filter, 1=Begins, 2=Ends, 3=Contains
    'FileNameFilterStr  : Search string used when FileFilterOption = 1, 2 or 3


    'This code below will list all files on the first sheet of this workbook
    'In column A :B the path/name, C the file date/time and D the size
    'You can browse to the folder you want when the code Run

    'In this example we list the file names but you can also use MySplit(FileInMyFiles)
    'in the loop to for example to open the files with Workbooks.Open(MySplit(FileInMyFiles))

    If MyFiles <> "" Then
        With Application
            .ScreenUpdating = False
        End With

        'Delete all cells in columns A:C in the first worksheet of this workbook
        Sheets(1).Columns("A:D").Cells.Clear

        'Split MyFiles and loop through all the files
        MySplit = Split(MyFiles, Chr(13))
        For FileInMyFiles = LBound(MySplit) To UBound(MySplit)
            On Error Resume Next
            Fstr = MySplit(FileInMyFiles)
            LastSep = InStrRev(Fstr, Application.PathSeparator, , 1)
            Sheets(1).Cells(FileInMyFiles + 1, 1).Value = Left(Fstr, LastSep - 1)    'Column A
            Sheets(1).Cells(FileInMyFiles + 1, 2).Value = Mid(Fstr, LastSep + 1, Len(Fstr) - LastSep)    'Column B
            Sheets(1).Cells(FileInMyFiles + 1, 3).Value = FileDateTime(MySplit(FileInMyFiles))    'Column C
            Sheets(1).Cells(FileInMyFiles + 1, 4).Value = FileLen(MySplit(FileInMyFiles))    'Column D
            On Error GoTo 0
        Next FileInMyFiles
        Sheets(1).Columns("A:D").AutoFit
        With Application
            .ScreenUpdating = True
        End With
    Else
        MsgBox "Sorry no files that match your criteria"
        'Delete all cells in columns A:C in the first worksheet of this workbook
        Sheets(1).Columns("A:D").Cells.Clear
        'ScreenUpdating is still True but we set it to true again to refresh the screen,
        With Application
            .ScreenUpdating = True
        End With
    End If

End Sub


'*******Function that do all the hard work that will be called by the macro*********

Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
    Dim ScriptToRun As String
    Dim folderPath As String
    Dim FileNameFilter As String
    Dim Extensions As String

    On Error Resume Next
    folderPath = MacScript("choose folder as string")
    If folderPath = "" Then Exit Function
    On Error GoTo 0

    Select Case ExtChoice
    Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)"  'xls, xlsx , xlsm, xlsb
    Case 1: Extensions = "xls"    'Only  xls
    Case 2: Extensions = "xlsx"    'Only xlsx
    Case 3: Extensions = "xlsm"    'Only xlsm
    Case 4: Extensions = "xlsb"    'Only xlsb
    Case 5: Extensions = "csv"    'Only csv
    Case 6: Extensions = "txt"    'Only txt
    Case 7: Extensions = ".*"    'All files with extension, use *.* for everything
    Case 8: Extensions = "(xlsx|xlsm|xlsb)"  'xlsx, xlsm , xlsb
    Case 9: Extensions = "(csv|txt)"  'csv and txt files
        'You can add more filter options if you want,
    End Select

    Select Case FileFilterOption
    Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' "  'No Filter
    Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' "    'Begins with
    Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' "    ' Ends With
    Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' "  'Contains
    End Select

    folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
                          Chr(34) & " to return quoted form of it's POSIX Path")
    folderPath = Replace(folderPath, "'\''", "'\\''")

    If Val(Application.Version) < 15 Then
        ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """)" & Chr(13)
        ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
        ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
        ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
        ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
        ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
        ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
        ScriptToRun = ScriptToRun & "foundPaths"
    Else
        ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
                      folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                      Level & """ "
    End If
    On Error Resume Next
    MyFiles = MacScript(ScriptToRun)
    On Error GoTo 0
End Function


Sub SortData()
    Dim rng As Range
    On Error Resume Next
    Set rng = Range("A1").CurrentRegion
    rng.Sort key1:=rng.Cells(1, 1), _
            order1:=xlAscending, _
            Header:=xlNo
    Application.ScreenUpdating = True
End Sub

---

how can i extract files from resource with progressbar ?

June 16, 2016, 9:32 am

≫ Next: Using ShellExecute in VB 6.0

≪ Previous: Using VB on Mac to find txt files in folder, copy tab into single document, and loop

$

0

0

Hi all

i use this code to extract database and other files from resource file

Code:

---

Public Sub LoadDataIntoFile(id As Integer, FileName As String)

Dim myArray() As Byte

Dim myFile As Long

If Dir(FileName) = "" Then

myArray = LoadResData(id, "CUSTOM")

myFile = FreeFile

Open FileName For Binary Access Write As #myFile

Put #myFile, , myArray

Close #myFile

End If

End Sub


Private Sub Command1_Click()
LoadDataIntoFile 101, App.Path & "\db.mdb"
End Sub

---

how can i use progressbar to know what the time to extract all file from my resource file

Using ShellExecute in VB 6.0

June 16, 2016, 10:39 am

≫ Next: Changing Listview Group Header Text Color

≪ Previous: how can i extract files from resource with progressbar ?

$

0

0

I'm trying to learn how to use this API function.
The code I have is:

'In Module:
Declare Function Shellexecute% Lib "shell.dll" _
(ByVal hwnd%, ByVal lpsz0p$, ByVal lpszFile$, ByVal spszParam$, ByVal lpszDir$, ByVal fsShowcmd%)
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Global Const SW_SHOWNORMAL = 1

'and attached to form1:

Private Sub cmdGo_Click()
Dim hwnd As Double, flag As Double

hwnd = GetForegroundWindow()

flag = Shellexecute(hwnd, "open", "C:\declaration.txt", "", _
"C:\", SW_SHOWNORMAL)

End Sub

I'm getting an error 6 overflow. the file C:\declaration.txt exists.

What am I doing wrong here? I was expecting the file to be displayed in a window.