excel 尝试在我的文档上重做导出按钮功能

rvpgvaaj 于 2023-04-13 发布在其他

关注(0)|答案(1)|浏览(93)

我最初是在我的代码中使用发送键，它可以工作，但它不能完全发挥作用，有时在代码执行过程中，它会比其他人更快地处理一些步骤，或者其他时候它实际上根本不会复制，只是制作一个空白文档，或者最后它会卡在一个空白的记事本上打开。寻找更彻底的导出和保存功能，任何帮助都是非常感谢的。我也尝试添加DoEvents作为一种方法来验证它是否做了每一步，但这也没有解决这个问题。

ub export_one_column()

    Dim fdObj As Object
    Application.ScreenUpdating = False
    Set fdObj = CreateObject("Scripting.FileSystemObject")
    If fdObj.FolderExists("C:\Call_Log") Then
    Else
        fdObj.CreateFolder ("C:\Call_Log")
        MsgBox "Call Log Folder has been created in your C\ Folder.", vbInformation, "Creating Folder"
    End If
    Application.ScreenUpdating = True

  Sheets("PrintTXT").Select
  Columns(3).Select
  Selection.Copy
        Shell "notepad.exe", 3
        DoEvents
        SendKeys "^v"
        DoEvents
        SendKeys "^s"
        DoEvents
        SendKeys "C:\Call_Log" & "\textfile-" & Format(Now, "ddmmyy-hhmmss") & ".txt"            '<<==== Change
        DoEvents
        SendKeys "{ENTER}"
        DoEvents
        SendKeys "%fx"
        DoEvents
        SendKeys "{NUMLOCK}", True
    
    Sheets("ENTRY FORM").Select
End Sub

excel

来源：https://stackoverflow.com/questions/75880414/trying-to-redo-my-export-button-function-on-my-document

1条答案

按热度按时间

hgncfbus1#

Option Explicit

Sub export_one_column()

Dim fdObj As Object
Application.ScreenUpdating = False
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\Call_Log") Then
Else
    fdObj.CreateFolder ("C:\Call_Log")
    MsgBox "Call Log Folder has been created in your C\ Folder.", vbInformation, "Creating Folder"
End If
Application.ScreenUpdating = True

    Dim LastRow As Long, tmpRange As Range, strFilename as String

    With ActiveWorkbook.Worksheets("PrintTXT")
        LastRow = .Columns("C").Cells(.Rows.Count).End(xlUp).Row
        Set tmpRange = .Range("C1").Resize(LastRow)
    End With

    strFilename = "C:\Call_Log" & "\textfile-" & Format(Now, "ddmmyy-hhmmss") & ".txt"

    With Workbooks.Add
        .Worksheets(1).Range("A1").Resize(LastRow).Value = tmpRange.Value
        .SaveAs Filename:=strFilename, FileFormat:=xlText
        .Close SaveChanges:=False
    End With

    Set tmpRange = Nothing
End Sub

赞(0）回复(0）举报 2023-04-13

我来回答

excel 尝试在我的文档上重做导出按钮功能

1条答案

相关问题

热门标签

最新问答