覆盖初始文件名

时间:2017-07-05 15:19:38

标签: excel vba excel-vba

在地方有一些帮助,我写了下面的代码,它完美地工作但我需要能够覆盖初始文件名(我们被要求用GetOpenFilename选择的那个)来包含!DNU!因此用户在选择它之后就知道了,而不是再次选择相同的文件,特别是因为他们将使用的文件都非常相似。您可以看到我尝试使用下面的行'重命名原始文本文件,但它没有做任何事情!任何有关这方面的帮助将不胜感激。

 Sub BACSConversion()

 Dim MyNewBook As String
 Dim MySaveFile As String
 Dim fileToOpen As Variant
 Dim fileName As String
 Dim sheetName As String
 Dim rCopy As Range

 'Turn off display alerts
  Application.DisplayAlerts = False
 'Turn off screen updates
  Application.ScreenUpdating = False

 'Ensures that the file open directory is always the same
   ChDir "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\"

 'Opens the folder to location to select txt file
  fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If fileToOpen <> False Then
    Workbooks.OpenText fileName:=fileToOpen, _
    DataType:=xlDelimited, Tab:=True
    End If
 'Creates the file name based on txt file name
  fileName = Mid(fileToOpen, InStrRev(fileToOpen, "\") + 1)
 'Creates the sheet name based on the active txt file
  sheetName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

 'Rename the original text file
  ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
 Limited" & sheetName & "!DNU!" & ".txt")

 'Save active file as...
  ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
 Limited\BACS File Original\" & _
   fileName & ".CSV"), FileFormat:=xlCSV


 'Selects all data in column A and copies to clipboard
  Set rCopy = Range("A1", Range("A1").End(xlDown))

 'Open the original document where the BACS file is located
  Workbooks.Open "S:\Accounts (New)\Management Information 
 (Analysis)\Phil Hanmore - Analysis\bacs conversation calc.xlsx"
 'Selects the worksheet called "Original"
  Sheets("Original").Range("A:A").ClearContents

 'Paste selected values from previous sheet
 rCopy.Copy
 Sheets("Original").Range("A1").PasteSpecial Paste:=xlPasteValues

 'Selects appropriate worksheet - Non-MyPayFINAL
  Sheets("Non-MyPay FINAL").Select

 'Selects all data in column A and copies to clipboard
 Range("A1", Range("A1").End(xlDown)).Select
 Selection.Copy

  'Add a new workbook
   Workbooks.Add
 'Paste selected values from previous sheet
  Selection.PasteSpecial Paste:=xlPasteValues

  'Build SaveAs file name (for CSV file)
   MySaveFile = Format(Now(), "DDMMYYYY") & "NonMyPayFINAL" & ".CSV"
  'Save template file as...(for CSV file)
   ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
   Limited\" & MySaveFile), FileFormat:=xlCSV

  'Build SaveAs file name (for Txt file)
   MySaveFile = Format(Now(), "DDMMYYYY") & "NonMyPayFINAL" & ".Txt"
  'Save template file as...(for Txt file)
   ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
  Limited\" & MySaveFile), FileFormat:=xlTextWindows

  'Close the new saved file
   ActiveWorkbook.Close

 'Selects appropriate worksheet - MyPayFINAL
   Sheets("MyPay FINAL").Select

  'Selects all data in column A and copies to clipboard
   Range("A1", Range("A1").End(xlDown)).Select
   Selection.Copy

  'Add a new workbook
   Workbooks.Add
 'Paste selected values from previous sheet
   Selection.PasteSpecial Paste:=xlPasteValues

  'Build SaveAs file name (for CSV file)
   MySaveFile = Format(Now(), "DDMMYYYY") & "MyPayFINAL" & ".CSV"
  'Save template file as...(for CSV file)
    ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
  Limited\" 
  & MySaveFile), FileFormat:=xlCSV

'Build SaveAs file name (for Txt file)
  MySaveFile = Format(Now(), "DDMMYYYY") & "MyPayFINAL" & ".Txt"
 'Save template file as...(for Txt file)
  ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
  Limited\" & MySaveFile), FileFormat:=xlTextWindows

 'Close the new saved file
  ActiveWorkbook.Close
 'Close original source workbook (template)
  Workbooks("bacs conversation calc").Close
 'Close final workbook
  ActiveWorkbook.Close savechanges:=True

  MsgBox "Your file has been processed successfully!", vbExclamation

 'Turn on display alerts
   Application.DisplayAlerts = True
 'Turn on screen updates
  Application.ScreenUpdating = True

  End Sub

  Sub FileNameChange()

  Dim oldPath As String
  Dim newPath As String

  oldPath = "S:\Accounts (New)\Management Information (Analysis)\Phil 
  Hanmore - Analysis\Neil Test\" & Test & ".xlsx"
  newPath = "S:\Accounts (New)\Management Information (Analysis)\Phil 
  Hanmore - Analysis\Neil Test\" & Test & "!DNU!.xlsx"



  End Sub

1 个答案:

答案 0 :(得分:2)

VBA中有一个名为Name [old/current path/name] [new path/name] 的内置函数,它的工作原理如下:

Name ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & Filename) ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & Filename & "!DNU!")

因此,对于您的代码,您可以这样做:

Dim oldPath As String, newPath as String

oldPath = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & sheetname & ".txt"
newPath = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & sheetname & "!DNU!.txt"

Name oldPath newPath

我建议将变量分配给路径,称之为oldpath和newpath。所以

import sys
import pika

connection = pika.BlockingConnection(pika.ConnectionParameters('localhost'))  # Connect to AMQP

def setup():
        channel = connection.channel()
        channel.exchange_declare(exchange='direct_logs', type='direct')
        return channel

def log_emitter(message, severity):
        channel = setup()
        channel.basic_publish(exchange='direct_logs',
                      routing_key=severity,
                      body=message)

def logger():
        severity = sys.argv[1] if len(sys.argv) > 2 else 'info'
        print severity
        exit = 'N'
        message = ' '.join(sys.argv[2:]) or "Hello World!"
        log_emitter(message, severity)
        print(" [x] Sent %r:%r" % (severity, message))
    connection.close()

logger()

但是,在您执行此操作之前,需要关闭该文件。因此,请确保通过循环打开工作簿并关闭它们来关闭文件。然后通过运行它,它应该将文件从旧名称重命名为新名称。

我建议制作一个新工作簿并将其放在桌面上并先测试,然后再将其与实际代码/工作簿一起使用。制作一个新工作簿,将其保存到桌面,将其命名为test.xlsx,然后关闭它。在单独的工作簿中,启动一个新的Sub并粘贴代码,但更改oldPath和newPath以反映您的桌面路径和test.xlsx文件。试一试。