Below is the code where I create subfolder A from the path on cell E3. This is the path: C:\SW\A. But what if I want to create these subfolders (A and B and C) using 1 path like C:\SW\A\B\C? This doesn't create the subfolders.
Sub MakeFolders()
Dim path As String
'mkdir function
path = Range("E3").Value
MkDir path
End Sub
any idea how to make 3 subfolders using only 1 path?
The Win32API, MakeSureDirectoryExists, will do what you're asking for - it will check if each folder in the path exists, and if not, it will make it. To use APIs, you need to make sure that Declaration component sits at the start of a module (along with its accompanying function, BuildDirPath)
#If VBA7 Then
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
#Else
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
#End If
Function BuildDirPath(ByVal Path As String) As Boolean
BuildDirPath = CBool(MakeSureDirectoryPathExists(Path) = 1)
End Function
To use it, it's simply a matter of calling the function BuildDirPath.
Debug.Print BuildDirPath("C:\SW\A\B\C")
It will return a TRUE value if it was successful. I should add that this API is limited to ASCII characters and does not support Unicode - which means that it cannot be used for a non-Western character set (e.g., Japanese hiragana). Hope that helps.
Related
So I've spent the evening trying to design snake in VBA. Great stuff. It seemed to be working fine whenever I ran the Main Sub from the VBA window (by clicking the play button in the top ribbon), however when I added a button on the worksheet for the same sub, it runs with no errors but the controls don't behave in the same way. Originally each time you press an arrow you just change direction, however when running the macro through a button you can keep holding the arrow in the direction you're going and it speeds up the snake, so the cell select behaves as it normally would in Excel, rather than as required in snake. This defeats the purpose of the game as the rest of the snake can't catch up with the head and creates gaps within allowing the user to just jump through it.
I'm using GetAsyncKeyState to read key presses:
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
#End If
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
And then calling this with If Statements:
' Key press handling
WasteTime (speed)
If GetAsyncKeyState(VK_DOWN) Then
PressDown
ElseIf GetAsyncKeyState(VK_UP) Then
PressUp
ElseIf GetAsyncKeyState(VK_LEFT) Then
PressLeft
ElseIf GetAsyncKeyState(VK_RIGHT) Then
PressRight
End If
' Offset by key direction or default
ActiveCell.Offset(cellrow, cellcol).Select
For reference, this is all that each key function does:
Function PressUp()
cellrow = -1
cellcol = 0
End Function
Any help would be greatly appreciated. I suspect this has something to do with me declaring the GetAsyncKeyState function in the General Declarations section, but as I've never done this before, can't quite work out what I'm doing wrong. Thanks :)
Private Declare PtrSafe Function GenerateActiveTypicalWorksheet Lib "C:\Program Files\EPLAN\EEC One\2.7.3\Platform64\W3ApiBase.dll" Alias "EecOne.GenerateActiveTypicalWorksheet" () As Integer
Call Application.Run("EecOne.GenerateActiveTypicalWorksheet")
End Function
Private Sub Workbook_Open()
GenerateActiveTypicalWorksheet
End Sub
I'm trying to call a function within the .dll file and I get the error 'Invalid outside procedure'.
This is the only piece of documentation available for the dll/API I'm trying to use:
and this:
Syntax should be like this:
Private Declare PtrSafe Function GenerateActiveTypicalWorksheet Lib "C:\Program Files\EPLAN\EEC One\2.7.3\Platform64\W3ApiBase.dll" Alias "EecOne.GenerateActiveTypicalWorksheet" () As Integer
Private Sub Workbook_Open()
GenerateActiveTypicalWorksheet
End Sub
Note that Private Declare PtrSafe Function is just like a reference to a function in a library. It's just to make it available and has no source code and no End Function. It's more like a link to a function.
Issue here was that these two lines …
Call Application.Run("EecOne.GenerateActiveTypicalWorksheet")
End Function
were not within a function or procedure therefore you got the error …
Invalid outside procedure
How do you use an environment variable in an Excel sheet connection string, getting the error, ODBC Excel Driver Login Failed ... is not a valid path
If the provider errors then its not expanding the strings and you will need to do it manually, running the string through a function before assigning.
In a module:
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Function ExpandEnv(str As String) As String
Dim size As Long
size = ExpandEnvironmentStrings(str, ExpandEnv, size)
ExpandEnv = Space$(size)
size = ExpandEnvironmentStrings(str, ExpandEnv, size)
ExpandEnv = Left$(ExpandEnv, size - 1)
End Function
For
?ExpandEnv("aaa %temp% bbb %username% ccc")
aaa C:\NULL bbb AlexK ccc
this code is supposed to be used in VB. port number and IP address is available. how to prevent packets from entering is to be known. Its similar to the work a FireWall does.
Ur own Personal FIREwall!!
Here is some sample VB6 code to get You started.
It makes use of the winsock control to open and connect to a port itself.
Thereby it automatically denying access to port by other process.
Public Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
End Type
Public Type MIB_TCPTABLE
dwNumEntries As Long
table(100) As MIB_TCPROW
End Type
Public MIB_TCPTABLE As MIB_TCPTABLE
Public Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As
MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Declare Function SetTcpEntry Lib "IPhlpAPI" (pTcpRow As MIB_TCPROW)
As Long
Public Declare Function ntohs Lib "WSOCK32.DLL" (ByVal netshort As Long) As
Long
Public Sub BlockPort
Dim LTmp As Long
Dim x As Integer, i As Integer, n As Integer
Dim RemP As String
Dim tcpt As MIB_TCPTABLE
LTmp = Len(MIB_TCPTABLE)
GetTcpTable tcpt, LTmp, 0
x = tcpt.dwNumEntries
For i = 0 To tcpt.dwNumEntries - 1
RemP = ntohs(tcpt.table(i).dwRemotePort)
If RemP = "8080" And tcpt.table(i).dwState <> 2 Then
tcpt.table(i).dwState = 12
SetTcpEntry tcpt.table(i)
End If
Next i
End Sub
If you are looking an easier way to block a single port then :
Use a Winsock Control in your VB form.
Set its localport property to the port number you want to block
Complete reference of Winsock for VB6 here
...and Thats IT!! Your own personal firewall is up!!
GoodLUCK!!
- CVS
Is there a way to rename all methods, properties etc. suggested by R#. I have code that I converted from java and all methods and properties are in the format like this "onBeforeInsertExpression" and I want them to follow camel casing that is common in .NET.
This question is also for CodeRush.
I needed the same functionality and couldn't find it. I considered writing an add-in to ReSharper using the Api but decided on a regular Visual Studio macro instead. This macro renames methods and private fields in the current document to the default ReSharper settings, but can easily be modified to iterate through all files in a project or solution.
Save this code as a .vb file and import it into your VS Macros.
Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports EnvDTE90a
Imports EnvDTE100
Imports System.Diagnostics
Public Module RenameMembers
Enum NamingStyle
UpperCamelCase
LowerCamelCase
End Enum
Public Sub RenameMembers()
Try
'Iterate through all code elements in the open document
IterateCodeElements(ActiveDocument.ProjectItem.FileCodeModel.CodeElements)
Catch ex As System.Exception
End Try
End Sub
'Iterate through all the code elements in the provided element
Private Sub IterateCodeElements(ByVal colCodeElements As CodeElements)
Dim objCodeElement As EnvDTE.CodeElement
If Not (colCodeElements Is Nothing) Then
For Each objCodeElement In colCodeElements
Try
Dim element As CodeElement2 = CType(objCodeElement, CodeElement2)
If element.Kind = vsCMElement.vsCMElementVariable Then
RenameField(element)
ElseIf element.Kind = vsCMElement.vsCMElementFunction Then
'Rename the methods
ApplyNamingStyle(element, NamingStyle.UpperCamelCase)
ElseIf TypeOf objCodeElement Is EnvDTE.CodeNamespace Then
Dim objCodeNamespace = CType(objCodeElement, EnvDTE.CodeNamespace)
IterateCodeElements(objCodeNamespace.Members)
ElseIf TypeOf objCodeElement Is EnvDTE.CodeClass Then
Dim objCodeClass = CType(objCodeElement, EnvDTE.CodeClass)
IterateCodeElements(objCodeClass.Members)
End If
Catch
End Try
Next
End If
End Sub
'Rename the field members according to our code specifications
Private Sub RenameField(ByRef element As CodeElement2)
If element.Kind = vsCMElement.vsCMElementVariable Then
Dim field As EnvDTE.CodeVariable = CType(element, EnvDTE.CodeVariable)
If (field.Access = vsCMAccess.vsCMAccessPrivate) Then
'private static readonly
If (field.IsShared AndAlso field.IsConstant) Then
ApplyNamingStyle(element, NamingStyle.UpperCamelCase)
ElseIf (Not field.IsShared) Then
'private field (readonly but not static)
ApplyNamingStyle(element, NamingStyle.LowerCamelCase, "_")
Else
ApplyNamingStyle(element, NamingStyle.UpperCamelCase)
End If
Else
'if is public, the first letter should be made uppercase
ToUpperCamelCase(element)
End If
'if public or protected field, start with uppercase
End If
End Sub
Private Function ApplyNamingStyle(ByRef element As CodeElement2, ByVal style As NamingStyle, Optional ByVal prefix As String = "", Optional ByVal suffix As String = "")
Dim the_string As String = element.Name
If (Not the_string Is Nothing AndAlso the_string.Length > 2) Then
If (style = NamingStyle.LowerCamelCase) Then
ToLowerCamelCase(the_string)
ElseIf (style = NamingStyle.UpperCamelCase) Then
ToUpperCamelCase(the_string)
Else
'add additional styles here
End If
End If
AddPrefixOrSuffix(the_string, prefix, suffix)
If (Not element.Name.Equals(the_string)) Then
element.RenameSymbol(the_string)
End If
End Function
Private Function ToLowerCamelCase(ByRef the_string As String)
the_string = the_string.Substring(0, 1).ToLower() & the_string.Substring(1)
End Function
Private Function AddPrefixOrSuffix(ByRef the_string As String, Optional ByVal prefix As String = "", Optional ByVal suffix As String = "")
If (Not the_string.StartsWith(prefix)) Then
the_string = prefix + the_string
End If
If (Not the_string.EndsWith(suffix)) Then
the_string = the_string + suffix
End If
End Function
Private Function ToUpperCamelCase(ByRef the_string As String)
the_string = the_string.Substring(0, 1).ToUpper() & the_string.Substring(1)
End Function
End Module
No, unfortunately there isn't a way. Resharper's Code Cleanup / Reformat Code options work nicely for formatting, namepaces, etc, but will not do any automatic member renaming. You're kinda stuck doing a "Quick Fix" on each member. If you have a lot of them, this can be a pain...
CodeRush's approach to this kind of fix is more of an interactive process.
Which is to say you have to physically be in the location of the variable whose name you wish to change and you have to change each one individually.
That said, there is a very powerful engine under CodeRush called the DXCore, which can be used to create a very wide variety of functionality. Indeed it is this layer on which the whole of CodeRush and RefactoPro are built.
I have no doubt that it could be used to create the functionality you are after. However I doubt that you would use the existing rename technology. I will have to look into this a little further, but I am optimistic about being able to produce something.