请帮助改进excel VBA到2017年Visual Studio的代码 [英] Please help to adapt code from excel VBA to visual studio 2017

问题描述

亲爱的专家，

我在vba excel中观察到了所需的代码，但是我无法将其移动到visual studio并作为单独的exe-application组合。你能帮帮我吗？



我尝试过的事情：



< pre lang =vb> ' 当文件被删除到用户表单中的TreeView时调用过程
私有 Sub ExportTreeView_OLEDragDrop（数据 As MSComctlLib.DataObject，Effect As Long ，Button As 整数，Shift 作为 整数，X 作为 单，Y 作为 单个）
Dim fso As 新 FileSystemObject
Dim fld As 文件夹
Dim fls 作为文件
Dim sFileName As 字符串
Dim sFilePath As 字符串
Dim iTotalTreeElems As 整数
Dim sFilesArray（） As 字符串
Dim iTotalFiles As 长
Dim sBufArray（ 1000 ） As 字符串
Dim sBufSize As < span class =code-keyword>整数
Dim sRepName As < span class =code-keyword> String

Dim iRows As 整数
Dim sActiveSheet As 字符串
Dim sKey As 字符串
Dim sMask As 字符串
Dim sStr As 字符串
Dim i 作为 整数
Dim j 作为 整数

申请表.ScreenUpdating = False
sActiveSheet = ThisWorkbook.ActiveSheet.Name



ThisWorkbook.Sheets（< span class =code-string> UserForm）。选择
sKey = ' ExportForm.edtFilterKey.Text
iRows = Application.WorksheetFunction.CountA（Range（ A：A））
iTotalTreeElems = Data.Files.Count
iTotalFiles = 0
sBufSize = 0

' 获取文件列表来自所有文件夹和子文件夹
对于 i = 1 iTotalTreeElems

' 检查dir是文件夹还是filename
如果（fso.FolderExists（Data.Files（i））= True ）然后
调用 General.GetFileList（sFilesArray，Data.Files（i））
否则
iTotalFiles = General.GetArraySize（sFilesArray）
ReDim 保留sFilesArray（iTotalFiles）
sFilesArray（iTotalFiles）= Data.Files（i）
结束 如果
下一步 i

iTotalFiles = General.GetArraySize（sFilesArray）

' 浏览必要文件列表通过掩码识别文件是否适合任何文件
对于 i = 2 < span class =code-keyword>到 iRows
sMask = ThisWorkbook.ActiveSheet.Cells（i， 4 ）

' iTotFiles = Data.Files.Count
对于 j = 1 要 iTotalFiles

< span class =code-keyword>如果 sFilesArray（j - 1 ）<> 然后
sFileName = fso.GetFileName（sFilesArray（j - 1 ））
sFilePath = fso.GetParentFolderName（sFilesArray（j - 1 ））

' 检查文件是否与当前面具匹配
如果 General.CheckMask（sFileName，sMask）= True 然后
' ThisWorkbook.ActiveSheet.Cells（i，3）= sFileName
' ThisWorkbook.ActiveSheet.Cells（i，6）= sFilePath

sBufArray（sBufSize）= sFil esArray（j - 1 ）
sBufSize = sBufSize + 1

' sFilesArray（j - 1）=

' Data.Files.Remove（j - 1）
' 退出
结束 如果
结束 如果
下一步 j

sKey = RemoveFiltrSymbols（sKey）

' 如果多个文件匹配Mask，则选择一个具有关键字的文件
如果 sBufSize> 1 然后
对于 j = 1 sBufSize
sRepName = RemoveFiltrSymbols（sBufArray（j - 1 ））

如果 InStr（UCase（sRepName），UCase（sKey））然后
ThisWorkbook.ActiveSheet.Cells（i， 3 ）= fso.GetFileName（sBufArray（j - 1 ））
ThisWorkbook.ActiveSheet.Cells（i， 6 ）= fso.GetParentFolderName（sBufArray（ j - 1 ））
结束 如果
下一步 j
其他
如果 sBufSize = 1 那么
ThisWorkbook.ActiveSheet.Cells（i， 3 ）= fso.GetFileName（sBufArray（ 0 ））
ThisWorkbook.ActiveSheet.Cells（i， 6 ）= fso.GetParentFolderName（sBufArray（ 0 ））
结束 如果
结束 如果

sBufSize = 0
下一步 i

ThisWorkbook.Sheets（sActiveSheet）。选择

Application.ScreenUpdating = True

结束 <温泉n class =code-keyword> Sub

解决方案

它不是那样的工作。

我们不为您工作 - 我们不是代码翻译服务。

如果您希望有人编写您的代码，您必须付费 - 我建议您去Freelancer .com并在那里问。



但要注意：你得到的是你付出的代价。支付花生，买猴子。



发展的概念就像这句话所暗示的那样：系统地运用科学和技术知识来满足特定的目标或要求。 BusinessDictionary.com [ ^ ]

这与有一个不一样快速谷歌并放弃，如果我找不到完全正确的代码。

所以要么付钱给别人去做，要么学会如何自己写。我们不是为你做的。

VBA与VB.NET的原因并不相同！



如果您了解上述代码的作用，可以使用.NET技术从头开始编写。请参阅MSDN文档：如何在Visual Basic .NET或Visual Basic 2005应用程序中添加TreeView拖放功能 [ ^ ]



您将在CP KnowledgeBase上找到的另一篇非常有趣的文章： TreeView拖放简介（VB.NET） [ ^ ]

Dear Experts,
I observed the needed code in vba excel but I cannot move it to visual studio and combine as separate exe-application. Can you help me?

What I have tried:

'Procedure is called when files are dropped to the TreeView in the user form
Private Sub ExportTreeView_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim fso As New FileSystemObject
    Dim fld As Folders
    Dim fls As Files
    Dim sFileName As String
    Dim sFilePath As String
    Dim iTotalTreeElems As Integer
    Dim sFilesArray() As String
    Dim iTotalFiles As Long
    Dim sBufArray(1000) As String
    Dim sBufSize As Integer
    Dim sRepName As String
    
    Dim iRows As Integer
    Dim sActiveSheet As String
    Dim sKey As String
    Dim sMask As String
    Dim sStr As String
    Dim i As Integer
    Dim j As Integer
    
    Application.ScreenUpdating = False
    sActiveSheet = ThisWorkbook.ActiveSheet.Name
    
    
    
    ThisWorkbook.Sheets("UserForm").Select
    sKey = "" 'ExportForm.edtFilterKey.Text
    iRows = Application.WorksheetFunction.CountA(Range("A:A"))
    iTotalTreeElems = Data.Files.Count
    iTotalFiles = 0
    sBufSize = 0
    
    'Get list of files from all folders and subfolders
    For i = 1 To iTotalTreeElems
        
        'Check if dir is folder or filename
        If (fso.FolderExists(Data.Files(i)) = True) Then
            Call General.GetFileList(sFilesArray, Data.Files(i))
        Else
            iTotalFiles = General.GetArraySize(sFilesArray)
            ReDim Preserve sFilesArray(iTotalFiles)
            sFilesArray(iTotalFiles) = Data.Files(i)
        End If
    Next i
    
    iTotalFiles = General.GetArraySize(sFilesArray)
    
    'Go through the list of neccessary files and identify if files suits any of them by mask
    For i = 2 To iRows
        sMask = ThisWorkbook.ActiveSheet.Cells(i, 4)
    
        'iTotFiles = Data.Files.Count
        For j = 1 To iTotalFiles
            
            If sFilesArray(j - 1) <> "" Then
                sFileName = fso.GetFileName(sFilesArray(j - 1))
                sFilePath = fso.GetParentFolderName(sFilesArray(j - 1))
                
                'Check if file match current mask
                If General.CheckMask(sFileName, sMask) = True Then
                    'ThisWorkbook.ActiveSheet.Cells(i, 3) = sFileName
                    'ThisWorkbook.ActiveSheet.Cells(i, 6) = sFilePath
                    
                    sBufArray(sBufSize) = sFilesArray(j - 1)
                    sBufSize = sBufSize + 1
                    
                    'sFilesArray(j - 1) = ""
                    
                    'Data.Files.Remove (j - 1)
                    'Exit For
                End If
            End If
        Next j
        
        sKey = RemoveFiltrSymbols(sKey)
        
        'If more than one file matched Mask then selecet one that has key word
        If sBufSize > 1 Then
            For j = 1 To sBufSize
                sRepName = RemoveFiltrSymbols(sBufArray(j - 1))
                
                If InStr(UCase(sRepName), UCase(sKey)) Then
                    ThisWorkbook.ActiveSheet.Cells(i, 3) = fso.GetFileName(sBufArray(j - 1))
                    ThisWorkbook.ActiveSheet.Cells(i, 6) = fso.GetParentFolderName(sBufArray(j - 1))
                End If
            Next j
        Else
            If sBufSize = 1 Then
                ThisWorkbook.ActiveSheet.Cells(i, 3) = fso.GetFileName(sBufArray(0))
                ThisWorkbook.ActiveSheet.Cells(i, 6) = fso.GetParentFolderName(sBufArray(0))
            End If
        End If
        
        sBufSize = 0
    Next i
    
    ThisWorkbook.Sheets(sActiveSheet).Select
    
    Application.ScreenUpdating = True
    
End Sub

解决方案

It doesn't quite work like that.
We do not do your work for you - we are not a code translation service.
If you want someone to write your code, you have to pay - I suggest you go to Freelancer.com and ask there.

But be aware: you get what you pay for. Pay peanuts, get monkeys.

The idea of "development" is as the word suggests: "The systematic use of scientific and technical knowledge to meet specific objectives or requirements." BusinessDictionary.com[^]
That's not the same thing as "have a quick google and give up if I can't find exactly the right code".
So either pay someone to do it, or learn how to write it yourself. We aren't here to do it for you.

VBA is not the same as VB.NET for set of reason!

If you understand what above code does, you can write it from scratch using .NET technology. Please, see MSDN documentation: How to add TreeView drag-and-drop functionality in a Visual Basic .NET or Visual Basic 2005 application[^]

Another very interesting article you'll find on CP KnowledgeBase: Introduction to TreeView Drag and Drop (VB.NET)[^]

这篇关于请帮助改进excel VBA到2017年Visual Studio的代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！